Having a quick look at this, it mostly works for me as your link test1, apart from the blocks - I haven't got time just now to work out why
I changed the hatch slightly for the polylines, circles etc to be a bit quicker and added an undo marker - I'll see if I get chance to look at the blocks later
(defun c:test1 ( / Lay_Old MySS target_layers block_names layer_name hatch_pattern )
(setq Lay_Old (getvar 'clayer)) ; Record the current layer
; Define a list of layers for hatching with different patterns
(setq target_layers
'(
("Layer1" "SOLID")
("Layer2" "SOLID")
("Layer3" "SOLID")
("Layer4" "SOLID")
("Layer5" "ANSI31")
("Layer6" "ANSI31")
("New Layer" "ANSI31")
("New Layer" "SOLID")
; Add more layers here as needed
) ; end list
) ; end setq
; Define a list of block names to hatch
(setq block_names '("CIRCL" "Triangle" "MH3"))
;;Added undo mark
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark thisdrawing)
(foreach layer_data target_layers
(setq layer_name (car layer_data))
(setq hatch_pattern (cadr layer_data))
; Set the current layer to "Chamber_Hatch" if the hatch pattern is "ANSI31"
(if (equal hatch_pattern "ANSI31")
(setvar 'clayer "Chamber_Hatch")
)
; Set the current layer to "Features_Hatch" if the hatch pattern is "SOLID"
(if (equal hatch_pattern "SOLID")
(setvar 'clayer "Features_Hatch")
)
; Select objects for hatching
(setq MySS (ssget "X" (list '(0 . "*POLYLINE,CIRCLE,ARC,RECTANGLE") (cons 8 layer_name))))
(if MySS
(progn
; (setq i 0)
; (repeat (sslength MySS)
; (setq ename (ssname MySS i))
(if (equal hatch_pattern "SOLID")
; (command "-hatch" "S" ename "" "P" "SOLID" "")
; (command "-hatch" "P" hatch_pattern 0.03 0.0 "S" ename "" "")
;;Changed to this, removes a loop and is quicker
(command "-hatch" "S" MySS "" "P" "SOLID" "")
(command "-hatch" "P" hatch_pattern 0.03 0.0 "S" MySS "" "")
) ; end if
; (setq i (1+ i))
; ) ; end repeat
) ; end progn
) ; end if
; Select and hatch blocks
(foreach block_name block_names
(setq MySS (ssget "X" (list '(0 . "INSERT") (cons 8 layer_name) (cons 2 block_names))))
(if MySS
(progn
(setq i 0)
(repeat (sslength MySS)
(setq ename (ssname MySS i))
(if (equal hatch_pattern "SOLID")
(command "-hatch" "S" ename "" "P" "SOLID" "")
(command "-hatch" "P" hatch_pattern 0.03 0.0 "S" ename "" "")
)
(setq i (1+ i))
)
)
)
)
; Reset the current layer to the original layer
(setvar 'clayer Lay_Old)
)
;;added this line
(vla-endundomark thisdrawing)
(princ) ; End quietly
)