Hatch to each of the closed polylines (Match the colour, Layer)

[3dwannab]

Hi all, there's no point in reinventing the wheel. I was looking to see if there's a program to hatch each of the closed polylines to match each layer and colour.

 

I'm doing a schedule for each room so this would be fairly handy.

 

Thanks in advance.

Solid Hatch Each Boundary With Properties of Boundary.dwg

[fuccaro]

(defun c:MyHatch()
  (setq ss (ssget "X" (list '(0 . "LWPOLYLINE") '(70 . 1))))
  (repeat (setq i (sslength ss))
    (setq p (ssname ss (setq i (1- i))))
    (setq pl (entget p)
	  lay (assoc 8 pl)
	  color (assoc 62 pl)
	  )
    (command "_hatch" "s" p "")
    (setq hatch (entget (entlast))
	  hatch (subst lay (assoc 8 hatch) hatch)	  
	  )
    
    (cond
      (color (setq hatch (append hatch (list color))))
      )
    
    (entmod hatch)
    )
   (setq ss nil)
  )

Just a quick one...

[3dwannab]

Thanks very much @fuccaro. I added undo handling and used the ":L" ssget to get preselection or selection.

 

Here's that if anyone wants it.

 

(vl-load-com)

;; See thread here: https://www.cadtutor.net/forum/topic/77467-hatch-to-each-of-the-closed-polylines-match-the-colour-layer/

;; Program to hatch closed polylines to match the layer and colour of each selection polyline.
;; Answer by fuccaro and added undo handling and changed the selection method by myself (3dwannab)

;; First written on 2023.05.11

(defun c:HBC nil (c:HH_Boundary_Colour))

(defun c:HH_Boundary_Colour (/ *error* acDoc hatch i p pl ss1 var_cmdecho var_osmode) 

  (defun *error* (errmsg) 
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg 
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (setvar 'cmdecho var_cmdecho)
    (setvar 'osmode var_osmode)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_osmode (getvar "osmode"))

  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  (setq ss1 (ssget ":L" (list '(0 . "LWPOLYLINE") '(70 . 1))))
  (repeat (setq i (sslength ss1)) 
    (setq p (ssname ss1 (setq i (1- i))))
    (setq pl    (entget p)
          lay   (assoc 8 pl)
          color (assoc 62 pl)
    )
    (command "_hatch" "s" p "")
    (setq hatch (entget (entlast))
          hatch (subst lay (assoc 8 hatch) hatch)
    )

    (cond 
      (color (setq hatch (append hatch (list color))))
    )

    (entmod hatch)
  )

  (*error* nil)
  (princ)
)

(princ (strcat " \n: ------------------------------\n'Hatch_Boundary_Colour.lsp' Loaded | Invoke by typing 'HH_Boundary_Colour' or 'HBC'.\n: ------------------------------\n"))
(princ)

 

Edited May 11 by 3dwannab

[fuccaro]

Glad to be helped.

Not a big deal, but I would add at the end 

(setq ss1 nil)

Have a good day!

[3dwannab]

Does localising the selection set not do the same?

[fuccaro]

Yes, defining SS1 as local variable, it will be destroyed once the function exits.

[Steven P]

19 hours ago, 3dwannab said:

Does localising the selection set not do the same?

 

Usually better this way in case SS1 has been used in another LISP as a global variable (not localised)

[mdchuyen]

On 5/11/2023 at 5:39 PM, 3dwannab said:

Thanks very much @fuccaro. I added undo handling and used the ":L" ssget to get preselection or selection.

 

Here's that if anyone wants it.

 

(vl-load-com)

;; See thread here: https://www.cadtutor.net/forum/topic/77467-hatch-to-each-of-the-closed-polylines-match-the-colour-layer/

;; Program to hatch closed polylines to match the layer and colour of each selection polyline.
;; Answer by fuccaro and added undo handling and changed the selection method by myself (3dwannab)

;; First written on 2023.05.11

(defun c:HBC nil (c:HH_Boundary_Colour))

(defun c:HH_Boundary_Colour (/ *error* acDoc hatch i p pl ss1 var_cmdecho var_osmode) 

  (defun *error* (errmsg) 
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg 
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (setvar 'cmdecho var_cmdecho)
    (setvar 'osmode var_osmode)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_osmode (getvar "osmode"))

  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  (setq ss1 (ssget ":L" (list '(0 . "LWPOLYLINE") '(70 . 1))))
  (repeat (setq i (sslength ss1)) 
    (setq p (ssname ss1 (setq i (1- i))))
    (setq pl    (entget p)
          lay   (assoc 8 pl)
          color (assoc 62 pl)
    )
    (command "_hatch" "s" p "")
    (setq hatch (entget (entlast))
          hatch (subst lay (assoc 8 hatch) hatch)
    )

    (cond 
      (color (setq hatch (append hatch (list color))))
    )

    (entmod hatch)
  )

  (*error* nil)
  (princ)
)

(princ (strcat " \n: ------------------------------\n'Hatch_Boundary_Colour.lsp' Loaded | Invoke by typing 'HH_Boundary_Colour' or 'HBC'.\n: ------------------------------\n"))
(princ)

 

can you add hatch type option? It is defaulting to hatch solid

[BIGAL]

Big hint (setvar 'hpname "Ansi31")

[3dwannab]

Just need to fix the hatch as it was non-associative.

 

Here's that fix

; (command "_hatch" "s" p "") ;; Original hatch command. Created a non-associative hatch

(command "-hatch" "P" "SOLID" "A" "A" "Y" "" "T" "." "S" p "" "") ;; Working for solid hatch with asssocitivity

 

@mdchuyen, to hatch with pattern name:

(command "-hatch" "P" "Ansi31" "555" "0" "A" "A" "Y" "" "T" "." "S" p "" "") ;; Hatch with pattern name where scale is 555.

 

Edited May 16 by 3dwannab

[mdchuyen]

1 hour ago, 3dwannab said:

Just need to fix the hatch as it was non-associative.

 

Here's that fix

; (command "_hatch" "s" p "") ;; Original hatch command. Created a non-associative hatch

(command "-hatch" "P" "SOLID" "A" "A" "Y" "" "T" "." "S" p "" "") ;; Working for solid hatch with asssocitivity

 

@mdchuyen, to hatch with pattern name:

(command "-hatch" "P" "Ansi31" "555" "0" "A" "A" "Y" "" "T" "." "S" p "" "") ;; Hatch with pattern name where scale is 555.

 

may appear table to choose "(initdia)"

[3dwannab]

I wonder what the easiest way to get the hatch to go to a true colour is if the polyline is. 

 

This is my brute-force method.

(command "_.matchprop" "_non" p "_non" (entlast) "")

 

Is there a variable or registry value for match prop settings. It was asked before on theswamp but that thread is 12 year old. https://www.theswamp.org/index.php?topic=37406.0

 

I'm sure there was one and I had it in one of my programs but can't find it anywhere.

Edited May 17 by 3dwannab

[Steven P]

(command "chprop" (ssget "_:L-I") "" "COLOR" "t" "255,51,204" "")

 

(Crayola Razzle Dazzle Rose colour....)

 

 

and I don't care,. this is the lisp name, like it or not,.

 

 

(defun c:Lauper ( / ) ; True colours.
  (setq MyEnt (car (entsel)))
  (setq MyObj (vlax-ename->vla-object MyEnt))
;;https://adndevblog.typepad.com/autocad/2012/12/accessing-the-truecolor-property-using-visual-lisp.html
  (setq oColor (vlax-get-property MyObj 'TrueColor)
      clrR (vlax-get-property oColor 'Red)
      clrG (vlax-get-property oColor 'Green)
      clrB (vlax-get-property oColor 'Blue)
  )
;;Match colour
  (princ "Thanks, select objects to change")
  (command "chprop" (ssget "_:L-I") "" "COLOR" "t" (strcat (rtos clrR) "," (rtos clrG) "," (rtos clrB)) "")
)

 

[ronjonp]

On 5/17/2023 at 9:25 AM, 3dwannab said:

I wonder what the easiest way to get the hatch to go to a true colour is if the polyline is. 

 

This is my brute-force method.

(command "_.matchprop" "_non" p "_non" (entlast) "")

 

Is there a variable or registry value for match prop settings. It was asked before on theswamp but that thread is 12 year old. https://www.theswamp.org/index.php?topic=37406.0

 

I'm sure there was one and I had it in one of my programs but can't find it anywhere.

Give this a try. It will match INDEX, RGB and COLORBOOK as well as match the LAYER NAME. It has the added benefit of also leaving bylayer colors intact.

(defun c:foo (/ f h o s sp)
  ;; RJP » 2023-05-18
  (cond
    ((setq s (ssget '((0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))))
     (setq sp (vlax-ename->vla-object (cdr (assoc 330 (reverse (entget (ssname s 0)))))))
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (cond ((vlax-curve-isclosed e)
	      (setq h (vlax-invoke sp 'addhatch achatchobject "SOLID" :vlax-true))
	      (vlax-invoke h 'appendouterloop (list (vlax-ename->vla-object e)))
	      (setq f (vl-remove-if-not '(lambda (x) (member (car x) '(8 62 420 430))) (entget e)))
	      ;; Match layer and byobject colors
	      (entmod (append (entget (vlax-vla-object->ename h)) f))
	      (vla-evaluate h)
	     )
       )
     )
    )
  )
  (princ)
)

 

Edited May 18 by ronjonp

[3dwannab]

Never even thought of colour book @ronjonp. Thanks. 

 

This is proving a very handy tool.

 

Ps. I do like the name @Steven P. 

[3dwannab]

@ronjonp Is there any way to get the properties of transparency and apply them properties also?

[ronjonp]

@3dwannab add 440 to this list: '(8 62 420 430 440)