move polylines (or hatching) in multiple layers to other separate layers (Or create new layers)

[ferol]

Hallo, I need help.

I have more than 50 layers in Autocad.
In each layer there are polylines with associative hatches.

I need to use LISP in batch to move these polylines (or, conversely hatches) to other layer (existing or maybe create new...), so that the boundary polylines are in a different layer than hatches still associative with them. 

I have no problem to manually write for all those layers from which to which to move it.. It will be used the same way repeatedly in the future.

Example:

Polyline_01 + Hatch_01 is in Layer_01
Polyline_02 + Hatch_02 is in Layer_02
....

Possible Result A:

Hatch_01 is in Layer_01
Polyline_01 is in Layer_01x
Hatch_02 is in Layer_02
Polyline_02 is in Layer_02x
...

Possible Result B:

Hatch_01 is in Layer_01x
Polyline_01 is in Layer_01
Hatch_02 is in Layer_02x
Polyline_02 is in Layer_02

Importantly, there will not always be a complete list of layers in the DWG. So lisp will not get stuck if it doesn't find a layers list in the DWG.

I don't care if completely new layers are created or just moved to existing, because in the end I'll use a batch rename of all layers with a different lisp anyway, and what I need is an intermediate step.

Is there a suitable LISP for this?  Or can someone write it?

[ВeekeeCZ]

Removed.

[ferol]

Thank you

I haven't figured out how to make it work. It does nothing for me.

But I found this and it works fine:

(defun C:MTNL (/ ent elay ldata); = Move To -New Layer [and make that Layer]
  (prompt "\nTo make ...-New Layers and move objects to them,")
  (setq ss (ssget ":L")); not things on locked Layers
  (repeat (sslength ss)
    (setq
      ent (ssname ss 0); first [remaining] object in selection
      elay (cdr (assoc 8 (entget ent)))
      ldata ; Layer data without non-transferable elements
        (vl-remove-if-not
          '(lambda (x) (member (car x) '(0 100 2 70 62 6)))
          (entget (tblobjname "layer" elay))
        ); vl-remove-if-not & ldata
    ); setq
    (if
      (or
        (< (strlen elay) 5)
          ; not a long-enough Layer name to already end in -New with anything preceding
        (/= (strcase (substr elay (- (strlen elay) 3))) "-NEW"); not already on a Layer like that
      ); and
      (progn
        (entmake (subst (cons 2 (strcat elay "-New")) (assoc 2 ldata) ldata)); create Layer
        (command "_.chprop" ent "" "_layer" (strcat elay "-New") ""); move object to it
      ); progn
    ); if
    (ssdel ent ss); take that one out of selection
  ); repeat
); defun

[paullimapa]

Try this to see when picking a hatch if it’ll select the associated boundary 

; https://www.cadtutor.net/forum/topic/33677-how-to-select-the-hatch-boundaries/
 
(if (ssget "_:s" '((0 . "hatch")))
 (progn
   (vlax-for x
     (vla-get-activeselectionset
       (vla-get-activedocument
         (vlax-get-acad-object)
       )
     )
     (vla-getloopat x 0 'loop)
   ) 
   (if (eq (type loop) 'safearray)
     (setq loop (vlax-safearray->list loop))
   )
 )
)

[ronjonp · Accepted solution]

@ferol A sample drawing would help to see exactly what you're working with.

See if this helps out .. seems as though you just want different layers for hatches and the associated boundary.

(defun c:foo (/ el h nl l ln s)
  ;; RJP » 2023-02-06
  ;; Changes associative hatches to match boundary layer + "-HATCH"
  (if (setq s (ssget "_X" '((0 . "~HATCH"))))
    (foreach e (mapcar 'cadr (ssnamex s))
      (setq ln (cdr (assoc 8 (setq el (entget e)))))
      (foreach h el
	(cond ((and (and (= 330 (car h)) (= "HATCH" (cdr (assoc 0 (setq h (entget (cdr h)))))))
		    (setq nl (strcat ln "-HATCH"))
	       )
	       (or (tblobjname "layer" nl)
		   (entmake (subst (cons 2 nl)
				   (assoc 2 (entget (tblobjname "layer" ln)))
				   (entget (tblobjname "layer" ln))
			    )
		   )
	       )
	       (entmod (append h (list (cons 8 nl))))
	      )
	)
      )
    )
  )
  (princ)
)

[paullimapa]

this should give possible result a:

; chbl changes hatch boundary layer to same layer name with x at end
; in response to OP
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/move-polylines-or-hatching-in-multiple-layers-to-other-separate/m-p/11734716#M443384
(defun c:chbl (/ col flg get_hatch_b hbl lty lyr RM:createLayer)
(vl-load-com)

; get_hatch_b function to get all hatch boundaries if same layer as hatch & returns as obj list
; modified from:
; https://www.cadtutor.net/forum/topic/33677-how-to-select-the-hatch-boundaries/
(defun get_hatch_b (/ aec_setmrk aec_getmrk clyr i loop lpNum lst obb obbl obh ss ssb)
  ; aec_setmrk is used w/ (aec_getmrk) it sets pt. marker
(defun aec_setmrk (/ pt)
;	(if (setq aec_pt-mrk (entlast))
;		nil
;		(progn
			(command "_.Point" "@")
			(setq aec_pt-mrk (entlast))
			(entdel aec_pt-mrk)
;		)
;	)
) ;defun
; aec_getmrk starts at aec_pt-mrk (aec_setmrk) retrieves to current entity
(defun aec_getmrk ()
	(if aec_pt-mrk
		(progn
			(setq aec_ss (ssadd))
			(while (setq aec_pt-mrk (entnext aec_pt-mrk))
				(ssadd aec_pt-mrk aec_ss)
			)
			aec_ss
		)
	) ;if
) ;defun
 (if (setq ss(ssget "_X" '((0 . "Hatch")))) ; select all hatches
  (progn ; there are hatches
   (foreach x (mapcar 'cadr (ssnamex ss)) ; loop through hatch entities
     (setq obh (vlax-ename->vla-object x)) ; convert entity to obj
     (setq i 0) ; start count
     (vla-getloopat obh i 'loop) ; get hatch's boundary
     (if (eq (type loop) 'safearray) ; chk if boundary exists
      (progn ; there's boundary
       (setq lpNum (vla-get-numberofloops obh)) ; get # of boundaries
       (repeat lpNum
        (vla-getloopat obh i 'loop) ; get hatch's boundary
        (setq obbl (vlax-safearray->list loop)) ; convert to list
        (setq obb (car obbl)) ; get hatch boundary object
        (if (= (strcase(vla-get-Layer obh))(strcase(vla-get-Layer obb))) ; if hatch & boundary on same layer
         (setq lst (append lst (setq obbl (vlax-safearray->list loop)))) ; add to list
        )
        (setq i (1+ i)) ; increment
       ) ; repeat loop
      ) ; progn
      (progn ; there's no boundary
        (aec_setmrk) ; set marker
        (setq clyr (getvar"clayer")) ; get current layer
        (setvar"clayer" (vla-get-Layer(vlax-ename->vla-object x))) ; set current layer to hatch layer
        (command "_.-HATCHEDIT" x "_B" "_P" "_Y") ; create associative hatch boundaries
        (setvar"clayer"clyr) ; set layer back to original
        (setq ssb (aec_getmrk)) ; select all entities after marker in case multiple boundaries created
        (foreach y (mapcar 'cadr (ssnamex ssb)) ; loop through entity list
         (setq lst (append lst (list(vlax-ename->vla-object y)))) ; add to list
        ) ; foreach
      ) ; progn
     ) ; if
   ) ; foreach
;  (setq lst (mapcar 'vlax-vla-object->ename lst)) ; convert obj to ename
  ) ; progn
 ) ; if
 lst
) ; defun get_hatch_b 
; RM:createLayer function using vl to create layer with given properties
; refer to RM.lsp for vlax version
; https://forums.autodesk.com/t5/civil-3d-customization/lisp-for-layer-creation/m-p/11688925#M22758
 (defun RM:createLayer (name colorIndex linetype desc / lays lay)
  (setq lays (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Layers))
  (setq lay (vlax-invoke-method lays 'Add name))
  (vlax-put-property lay 'Color colorIndex)
  (vlax-put-property lay 'LineType linetype)
  (vlax-put-property lay 'Description desc)
 ) ; defun RM:createLayer
 (if (setq hbl (get_hatch_b)) ; if there are any hatch boundaries
  (progn
   (foreach x hbl 
    (setq lyr (vla-get-Layer x)) ; get layer name 
    (vlax-for vla-obj 
     (vla-get-layers(vla-get-activedocument(vlax-get-acad-object))) ; get list of layers
      (if(=(strcase(vlax-get-property vla-obj "Name"))(strcase lyr)) ; found matching name
       (progn
        (setq col (vla-get-color vla-obj)) ; get layer's color
        (setq lty (vla-get-Linetype vla-obj)) ; get layer's linetype
        (setq des (vla-get-Description vla-obj)) ; get layer's description
       ) ; progn
      ) ; if
      (if(=(strcase(vlax-get-property vla-obj "Name"))(strcat lyr "X")) ; chk if layer with x exists
        (setq flg T) ; found layer with x
      )
    ) ; vlax-for
    (if(not flg) ; if layer with x doesn't exist
      (RM:createLayer (strcat lyr "x") col lty (strcat des "-Boundary")) ; create layer
    ) 
    (vla-put-Layer x (strcat lyr "x")) ; change boundary obj to new layer
   ) ; foreach
   (princ"\nAll Hatch Boundary Layers Same As Hatch Sunccessfully Changed.")(princ)
  ) ; progn
  (progn
   (princ"\nNo Hatch Objects With Boundaries on Same Layer Found.")(princ)
  ) ; progn
 ) ; if
 (princ)
) ; defun

[ferol]

Thanks for the tip. I've started using the solution I found above. C:MTNL

But I will put this your aside and test if my solution doesn't work.

[paullimapa]

MTNL looks like requires you to manually select the hatches or boundaries instead of automatically changing all hatches or boundaries to different layers right?

[ferol]

Yes. There I used lisp to automatically select all the files. But if that's what you're doing, I'm going to test it. I'll save one extra command 🙂

[ferol]

Command: chbl

; error: too many arguments

... So for now I'm sticking with MTNL for time reasons. So far it suits me.

[paullimapa]

that's strange because chbl runs fine on multiple cad stations here...o well.

[ronjonp]

@ferol Did you try THIS ?

[komondormrex · Accepted solution]

collection. no check if layers locked however.

;****************************************************************************************************************************************************

(defun check_layer_exist (layer_name / )
		(if (vl-catch-all-error-p
				(vl-catch-all-apply 'vla-item
									(list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
										  layer_name
									)
				)
			)
			(vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) layer_name)
		)
		layer_name
)

;****************************************************************************************************************************************************

(defun c:delayer ()
	(vlax-map-collection
		(vla-get-modelspace (vla-get-database (vla-get-activedocument (vlax-get-acad-object))))
	   '(lambda (object)
				(cond
					(
						(and
							(= "AcDbPolyline" (vla-get-objectname object))
							(member '(102 . "{ACAD_REACTORS") (entget (vlax-vla-object->ename object)))
							(= "HATCH" (cdr (assoc 0 (entget (cdadr (member '(102 . "{ACAD_REACTORS") (entget (vlax-vla-object->ename object))))))))
							(= (vla-get-layer object) (cdr (assoc 8 (entget (cdadr (member '(102 . "{ACAD_REACTORS") (entget (vlax-vla-object->ename object))))))))
						)
							(vla-put-layer object (check_layer_exist (strcat (vla-get-layer object) "x")))
					)
					(
						t
					)
				)
		)
	)
	(princ)
)

;****************************************************************************************************************************************************

[ferol]

This is perfect 🙂

[ronjonp]

---

@ferol wrote:

This is perfect 🙂

---

This code is limited to LWPOLYLINE .. so if you have any other object hatched it will fail.

To fix this limitation comment out this line:

(= "AcDbPolyline" (vla-get-objectname object))

[ferol]

Thank you

There will always be only polylines in the DWG. DWG are exports from Sketchup and one special plugin inside Sketchup and it knows only polylines 🙂

[ronjonp]

---

@ferol wrote:

Thank you

There will always be only polylines in the DWG. DWG are exports from Sketchup and one special plugin inside Sketchup and it knows only polylines 🙂

---

Cool. You should look at the code I posted as well. It has the advantage of matching the polyline layer properties when creating the new hatch layer.

If you want the layer to end with "x" simply change this:

(setq nl (strcat ln "-HATCH"))

To this:

(setq nl (strcat ln "x"))

[ferol]

Sure, I immediately changed it to suit myself 🙂