Change Muliple Layer at once

[Halb10]

Hi there,

 

here a thing I want the do with LISP:

 

I want to change multiple Objects with different Layers, that each Layer change to a different Layer.

 

Example:

 

Select entities with

 (ssget "_:L" '((8 . "Layername1, Layername2, etc")))

 

Now change Layer:

 

Layername1 → 1_Layername1

Layername2 → 1_Layername2

 

I don't want to select each entity and than change its Layer. I want to do all entities at the same time with one command.

[aaryan]

Try this. Please note there is no error handler, quickly written.

 

(Defun c:test (/ sset i obj lyr newlyr)
 (setq sset (ssget "x" (list (cons 8 "Layername1,Layername2,..etc"))))
 (repeat (setq i (sslength sset))
   (setq obj (vlax-ename->vla-object (ssname sset (setq i (1- i)))))
   (setq lyr (vla-get-layer obj))
   (if (tblsearch "LAYER" (setq newlyr (strcat "1_" lyr)))
     (vla-put-layer obj newlyr)))
 (princ)
)

[Halb10]

Thanks for your quick reply aaryan.

 

But this doesn't do anything...unfortunately.

 

(Defun c:test (/ sset i obj lyr newlyr)
 (setq sset (ssget "_:L" (list (cons 8 "Umriss_04,Achsen,Bemassung"))))
 (repeat (setq i (sslength sset))
   (setq obj (vlax-ename->vla-object (ssname sset (setq i (1- i)))))
   (setq lyr (vla-get-layer obj))
   (if (tblsearch "LAYER" (setq newlyr (strcat "1_" lyr)))
     (vla-put-layer obj newlyr)))
 (princ)
)

 

Umriss_04

Achsen

Bemassung are my Layers

 

Umriss need to be on 1_Umriss

Achsen on 1_Achsen

and Bemssung on 1_Bemassung.

 

I hope thats a better example than the otherone.

[aaryan]

That's probably because you do not have new layers already made in the drawing.

 

Try with this.

 

(Defun c:test (/ sset i obj lyr newlyr)
 (setq llist (list "Umriss_04" "Achsen" "Bemassung")) ; more layers can be added
 
 (setq llayers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ; layer collections
 
 (foreach lay llist ; iterate each layer from llist variable
   
   (if (setq lyrprop (tblsearch "LAYER" lay)) ; search if layer available in the drawing
     (progn
(setq newlyr (vla-add llayers (strcat "1_" lay))) ; adds a new layer with "1_" as prefix

(vla-put-color newlyr (cdr (assoc 62 lyrprop))) ; put old layer color to new one

(vla-put-linetype newlyr (cdr (assoc 6 lyrprop)))))) ; ; put old layer linetype color to new one
 
 (setq sset (ssget "_:L" (list (cons 8 (apply 'strcat (mapcar '(lambda (a) (strcat a ",")) llist)))))) ; ssget
 
 (repeat (setq i (sslength sset))
   
   (setq obj (vlax-ename->vla-object (ssname sset (setq i (1- i))))) ; convert single entity ename to vla-object
   
   (setq lyr (vla-get-layer obj)) ; gets layername of the object e.g. Achsen
   
   (if (tblsearch "LAYER" (setq newlyr (strcat "1_" lyr))) ; search if new layer is available in the drawing e.g. 1_Achsen
     
     (vla-put-layer obj newlyr))) ; puts the object to new layer
 (princ)
)

[Tharwat]

Hi,

Give this a shot:

(defun c:test (/ ss in sn en ly)
 (if (setq ss (ssget "_X" '((8 . "Umriss_04,Achsen,Bemassung"))))
   (repeat (setq in (sslength ss))
   (setq sn (ssname ss (setq in (1- in)))
         en (entget sn)
         ly (assoc 8 en)
     )
     (entmod (subst (cons 8 (strcat "1_" (cdr ly))) ly en))
     )
   )
 (princ)
 )

[Halb10]

@aaryan

 

the "new" Layers are already in the drawing (forget that to mention), so

your first code did work , but i only checked Layer Umriss_04. So I thought it didin't work on all Layers. Sorry about that.

 

But Umriss_04 has color red and Layer 1_Umriss is yellow, so it only doesn't work for Layer with different colors.

 

It has to ignore the color of the Layer. Is this still possible?

 

Thank You for your help.

 

 

@Tharwat

 

it does the same thing as aaryan's second code, only that the new created Layers have the color white.

 

But thanks anyway.

[aaryan]

The first code does ignore the layer color. the code get the layer name e.g. Umriss_04 and put its object to 1_Umriss_04 but here Layer 1_Umriss_04 does not exist because the code is simply adding a prefix 1_ and searching the layer.

 

Try to rename the layer Umriss_04 to Umriss (because your new layer is 1_Umriss - no 04 in the end)

 

Hope it helps.

 

I can do it but its the day off now will do it tomorrow if you cannot achieve it by then

 

Thanks

[ronjonp]

Maybe THIS will help you.

[Halb10]

Ah i got it.

 

I can't rename the Layer, it's fix, because if I rename them i have to edit a ton of drawings.

 

I can't modify it by myself, I have not enough knowlege in LSIP.

But if it's possible that - lets say - that the selected Layer are A and B, where A change to C and B to D. (all four Layer exist in my drawing)

 

You are a great help. Very appreciated.

 

To ronjonp

 

Its close, but your code renames the Layer...

But thank you.

[ronjonp]

Ah i got it.

...

To ronjonp

 

Its close, but your code renames the Layer...

But thank you.

The code creates a new layer if it does not exist then tries to place the object on that layer.

[Halb10]

Oh...

Didn't pay enough attention. I'm a little bit in a hurry.

I Just saw the the Layername changed.

 

But work for Achsenand for Bemassung but not for Umriss.

Because of the different names Umriss_04 and 1_Umriss.

 

So it created a Layer named 1_Umriss_04.

 

I have another Layer named 2_Umriss. so is it easier to change Objects on Layer 1_Umriss to 2_Umriss. It is only the Prefix that changes.

 

Because if the to be changed layer has a different name i could add more Layerchanges like

 

eg.:

 

1_Umriss to 2_Umriss or 3_Umriss and vice versa

1_Achsen to 2_Achsen or 3_Achsen and vice versa

 

You see what i want to do ?

[ronjonp]

I'm not sure I follow what you are trying to accomplish. If you can apply some rules, you should not have to manually create the layers as the code will do it for you.

(defun c:foo (/ e el l pre s)
 (if (and (setq pre (getstring t "\nEnter prefix: "))
   (setq s (ssget ":L" (list (cons 8 (strcat "~" pre "*")))))
     )
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
     (setq el (entget (tblobjname "layer" (setq l (cdr (assoc 8 (entget e)))))))
     (if (not (tblobjname "layer" (strcat pre l)))
(entmakex (subst (cons 2 (strcat pre l)) (assoc 2 el) el))
     )
     (entmod (subst (cons 8 (strcat pre l)) (assoc 8 (entget e)) (entget e)))
   )
 )
 (princ)
)

Edited January 22, 2018 by ronjonp

[Halb10]

Ok, well I suck at explanation

 

I hope a picture will help to understand my goal here.

[Halb10]

here's the .dwg file

Drawing.dwg

[ronjonp]

Perhaps:

(defun c:foo (/ e el i l pre s)
 (if (and (setq pre (getstring t "\nEnter prefix: "))
   (setq s (ssget ":L" (list (cons 8 (strcat "~" pre "*")))))
     )
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
     (setq el (entget (tblobjname "layer" (setq l (cdr (assoc 8 (entget e)))))))
     (cond ((setq i (vl-string-search "_" l)) (setq l (vl-string-subst pre (substr l 1 (1+ i)) l)))
    ((setq l (strcat pre l)))
     )
     (and (not (tblobjname "layer" l)) (entmakex (subst (cons 2 l) (assoc 2 el) el)))
     (entmod (subst (cons 8 l) (assoc 8 (entget e)) (entget e)))
   )
 )
 (princ)
)

[Halb10]

Exactly what I wanted. Nicely done.

Thank you ronjonp.

[ronjonp]

Glad to help