Change Layer-Keep original properties LISP routine

I am looking for a LISP routine that will change the layer of multiple objects yet have is so each object maintains the same properties(i.e. color, linetype) of the original layer.

Thanks BigJim2112

My name was suppose to be BigJim2112 not "Bib" but must have pressed the wrong button. :roll:

Welcome to CADTutor.

Try this program;

(defun c:chglay  (/ lay sel int)
 ;; Tharwat - date: 30.may.2016 ;;
 (cond
   ((and (setq lay (getstring t "\nSpecify layer name:"))
         (not (tblsearch "LAYER" lay)))
    (alert (strcat "Layer name <" lay "> is not found !")))
   ((and (princ (strcat "\nSelect objects to move to layer <" lay "> :"))
         (setq sel (ssget "_:L" '((0 . "~VIEWPORT")))))
    (repeat (setq int (sslength sel))
      (entmod (append (entget (ssname sel (setq int (1- int))))
                      (list (cons 8 lay)'(62 . 256) '(6 . "ByLayer") '(370 . -1))))
      )
    )
   )
 (princ)
 )

Thanks Tharwat for the post. The routine changes the layers of the objects but the objects take on the color and linetype of the new layer.

BibJim2112 you need a two step entmod read the colour and linetype of the object and reset the "bylayer" to the old colour, if (assoc 62 obj) returns nil then obj is by layer so you must then go and read the layer table to find its default color setting.

; not tested !!
(repeat (setq int (sslength sel))
(setq obj (ssname sel (setq int (1- int))))
(setq col (assoc 62 obj)) ; need check here for by colour and look up layer table
(setq lt (assoc 1 obj)) ; need check here for by layer and look up layer table
      (entmod (append obj)
                      (list (cons 62 Col))
                      (list (cons 6 Lt))
                      (list (cons 8 lay))
      )

so each object maintains the same properties(i.e. color, linetype) of the original layer.

The routine changes the layers of the objects but the objects take on the color and linetype of the new layer.

I thought you did want them to change as described into your first post !

Anyway CODES UPDATED ABOVE.

Assuming I've correctly understood, please try the following:

(defun c:layerchange ( / enx idx itm lay lst new old sel )
   (while (and (/= "" (setq new (getstring t "\nSpecify new layer: "))) (not (snvalid new)))
       (princ "\nLayer name invalid.")
   )
   (if (and (/= "" new) (setq sel (ssget "_:L" '((0 . "~VIEWPORT")))))
       (repeat (setq idx (sslength sel))
           (setq enx (entget (ssname sel (setq idx (1- idx))))
                 old (assoc 8 enx)
           )
           (if (setq itm (cdr (assoc old lst)))
               (setq enx (append enx itm))
               (setq lay (entget (tblobjname "layer" (cdr old)))
                     lst (cons (list old (assoc 62 lay) (assoc 6 lay) (assoc 370 lay)) lst)
                     enx (append enx (cdar lst))
               )
           )
           (entmod (subst (cons 8 new) old enx))
       )
   )
   (princ)
)

Thank you Lee Mac. Very nice lisp to have if you want to move things to a hidden layer, but still want everything to look the same.

Thank you Lee Mac. Very nice lisp to have if you want to move things to a hidden layer, but still want everything to look the same.

You're welcome - I'm glad you find it useful!

Thanks guys for the help on this!!!! Programs work amazing. Lee Mac...not only has your program worked flawlessly but you have some cool stuff on your website. I am just starting to learn LISP and your site was a HUGE help. If you ever get to Orlando Florida I will buy you a beer(assuming you are 21 of course). LOL

Thanks guys for the help on this!!!! Programs work amazing. Lee Mac...not only has your program worked flawlessly but you have some cool stuff on your website. I am just starting to learn LISP and your site was a HUGE help. If you ever get to Orlando Florida I will buy you a beer(assuming you are 21 of course). LOL

Many thanks Jim - I'm delighted that you find the program and my site so useful, and I'll certainly keep your offer in mind if ever I'm in Orlando!

Lee,

Would it be easy to mod the code to keep the properties of the new layer as "bylayer"?

Look at this (list (cons 8 lay)'(62 . 256) '(6 . "ByLayer") '(370 . -1)))) and compare Lee's and Tharwats also check out what the assoc numbers 62, 6 & 370 actually mean. The original code by Tharwat only had the single (cons 8 lay) option so it would adopt the new layers properties.

Look at this (list (cons 8 lay)'(62 . 256) '(6 . "ByLayer") '(370 . -1)))) and compare Lee's and Tharwats also check out what the assoc numbers 62, 6 & 370 actually mean. The original code by Tharwat only had the single (cons 8 lay) option so it would adopt the new layers properties.

Thanks BIGAL. I now know what Im doing with my lunch break.

If you get stuck I'll happily help out - good luck!

On 5/31/2016 at 10:11 AM, Lee Mac said:

Assuming I've correctly understood, please try the following:

 

 Hi Lee, I've tried this and it appears it's not working in my example. See attached.

I'm looking to put all on layer zero and retain all other properties. Looking at the code I cannot see anything obvious. 

Test.dwg

The reason this isn't working is because the lisp pulls the linetype, linghtweight, and color from the layer the entity's are currently on. It also assumes that the entity's are set to bylayer as requested by the original poster.

Since your entity's seem have these properties already set all you have to do is change the layer they are on.

50 minutes ago, mhupp said:

The reason this isn't working is because the lisp pulls the linetype, linghtweight, and color from the layer the entity's are currently on. It also assumes that the entity's are set to bylayer as requested by the original poster.

Since your entity's seem have these properties already set all you have to do is change the layer they are on.

Oh, I see. I'll try mod it on non-company time when I can. 

Can you upload another dwg with the Before situation on the left and the after situation (The way you want the result to be) on the right?

On 9/7/2022 at 10:34 AM, Emmanuel Delay said:

Can you upload another dwg with the Before situation on the left and the after situation (The way you want the result to be) on the right?

 

Yeah sure, here you go. Any entities that are over ridden on their colour a put to the layer and the byLayer colours are translated to the new layer.  See the blue hatch.

Example.dwg

Try this.

So, the general way of doing it: 

- For every object I look if properties have been set, or if the property is ByLayer.

I did this for Color, Line Width, Line Type.  (If something is missing, tell me)

- If the property is ByLayer, then I look at the layer, and what properties the layer has.  Then I copy those layer properties to the object properties.

- Last action is to set the layer to "0"

See if it works, else let me know

(Feel free to rename the command.  I named it GLP for Get Layer Properties or something)

;; given a layer name, return a list of the properties of that layer.
(defun layer_get_properties (Lay / )
	laydata (entget (tblobjname "Layer" Lay))
)


(defun c:glp ( / ss i obj Lay ent layer_props col_obj col_lay wid_obj wid_lay typ_obj typ_lay)
	;; user selects objects
	(setq ss (ssget))
	
	(setq i 0)
	(repeat (sslength ss)		;; do for all select objects: 
		(setq obj (ssname ss i))
		(setq ent (entget obj))
		;; layer of the object
		(setq Lay (cdr (assoc 8 ent)))
		;; layer properties
		(setq layer_props (layer_get_properties Lay))

	;; COLOR	- property 62
		;; color of the object / color of the layer
		(setq col_obj (cdr (assoc 62 ent)))
		(setq col_lay (cdr (assoc 62 layer_props)))
		;; Now we'll see if the object has set the color, or if the color is ByLayer.
		;; If the color is ByLayer, then we should copy the color of the layer and set it to the object.
		(if (= nil col_obj)  ;; object layer is set to ByLayer.  
			(entmod (append ent (list (cons 62 col_lay)  ) ))
		)
		
	;; Line width	- property 370
		(setq wid_obj (cdr (assoc 370 ent)))
		(setq wid_lay (cdr (assoc 370 layer_props)))
		(if (= nil wid_obj) 
			(entmod (append ent (list (cons 370 wid_lay)  ) ))
		)
		
	;; Line type	- property 6
		(setq typ_obj (cdr (assoc 6 ent)))
		(setq typ_lay (cdr (assoc 6 layer_props)))
		(if (= nil typ_obj) 
			(entmod (append ent (list (cons 6 typ_lay)  ) ))
		)
		
		
		;;  set layer to "0"
		(entmod (subst (cons 8 "0") (assoc 8 ent) ent))
	
		(setq i (+ i 1))
	)
	(princ)
)