Changing object layer

[MS13]

Hi all. That is my 1st post in here

 

I am after lisp routine to change objects layer.

For example objects from layer 1.B need to be moved to layer 1.A. Layer 1.A exists so I can not change layer name only

I can imagine lisp would have list of layers in the code so I would add anything what I need in it

 

Thanks for every feedback

[rkmcswain]

Do you mean that Layer 1.A does NOT exist?

Otherwise, you could just use properties to change the layer.

 

Quick and dirty, no error checking

 

(defun c:foo ( / a n)
 (princ "\nSelect Objects to change ")
 (setq a (ssget))
 (setq n (getstring "\n Enter name of new layer "))
 (vl-cmdf "._layer" "_n" n "")
 (vl-cmdf "._change" a "" "_p" "_la" n "")
 (princ)
)

 

[MS13]

Hi rkmcswain

 

I will have to change 20 ish layers every 1-2 days so doing this manually will take long time and may be source of mistakes

 

Layer 1.A does exist and has objects on it

 

I will explain it again. I do have layers 1.A, 1.B, 2.A, 2.B, ..., 100.A, 100.B etc

I need all objects from B layers to be moved to A layers: 1.B goes to 1.A 

It like merging layer 1.A and 1.B into layer 1.A

The list of the layers I can amend by myself in *.lsp file

[dlanorh]

Try this, minimally tested. It selects every object in the drawing, and loops through them. It extracts the layer. If the layer name contains a "B" and a matching "A" layer is found it changes the objects layer from "?.B" to "?.A". It takes no account of locked layers or layers that may have an additional "B" in them.

(vl-load-com)

(defun rh:lyrxist ( lyr char / n_lyr rtn)
  (setq n_lyr (vl-string-subst char "B" lyr))
  (if (not (tblsearch "layer" n_lyr))
      (setq n_lyr nil)
  );end_if
  (setq rtn n_lyr)
);end_defun
  
(defun c:B2A ( / *error* c_doc)

	(defun *error* ( msg ) 
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
		(princ)
	);_end_*error*_defun

	(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq

	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(vla-startundomark c_doc)

  (setq ss (ssget "_X"))
  (vlax-for obj (vla-get-activeselectionset c_doc)
    (setq o_lyr (vlax-get-property obj 'layer))
    (cond ( (and (wcmatch (strcase o_lyr) "*.B")
                 (setq n_lyr (rh:lyrxist o_lyr "A"))
            )
            (vlax-put-property obj 'layer n_lyr)
          )
          (
           (princ (strcat "No matching Layer found for " o_lyr))
          )
    );end_cond
  );end_for
  (setq ss nil)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
);end_defun  

 

[ronjonp]

Another:

(defun c:foo (/ a s)
  (cond
    ((setq s (ssget ":L" '((8 . "*B*"))))
     (foreach x	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (setq a (entget x))
       (entmod (append a (list (cons 8 (vl-string-translate "B" "A" (strcase (cdr (assoc 8 a))))))))
     )
    )
  )
  (princ)
)

 

Edited October 4, 2018 by ronjonp

[MS13]

Could you please let me know when I should paste list of layers to be changed into your codes?

 

Layers 1.A and 1.B are just an example.

 

True names are like "Ss_25_12_65 Panel partition systems" and "Ss_25_12_65 Panel partition systems Texts", so I would like to move objects from layer "...Texts" to layer without it.

That is why I would like to key-in by myself layers to be changed somewhere in lisp structure without picking them up

 

Like an example please look on this. Lisp does something else, but amended my own lines 

 

Quote

(defun c:test ()
(Renlay "aq" "GL-Pr_65_70_)
(Renlay "wat" "GL-Pr_65_70_15")
(Renlay "CA" "GL-Ss_37_16_90_28-M")
(Renlay "Elec" "GL-Pr_65_70_48")

 

Lisp changes layers names from aq to GL-Pr_65_70_ and so on for all renlay commend

[dlanorh]

14 minutes ago, MS13 said:

Could you please let me know when I should paste list of layers to be changed into your codes?

 

Layers 1.A and 1.B are just an example.

 

True names are like "Ss_25_12_65 Panel partition systems" and "Ss_25_12_65 Panel partition systems Texts", so I would like to move objects from layer "...Texts" to layer without it.

That is why I would like to key-in by myself layers to be changed somewhere in lisp structure without picking them up

 

Like an example please look on this. Lisp does something else, but amended my own lines 

 

 

Lisp changes layers names from aq to GL-Pr_65_70_ and so on for all renlay commend

 

You can't. We both assumed that layer 1.A & 1.B ... 100.A & 100.B were literal layer names. The lisp moves objects, it doesn't rename layers.

 

I can modify my lisp, but the for that the layers need to be in a single list of list in the format ( ("old layer name" "new layer name"), or attach the complete list of layers as a text file.

[MS13]

Format ( ("old layer name" "new layer name") would be the best as the list is increasing.

Please just put for now

( ("old1" "new1")

( ("old2" "new2")

( ("old3" "new3")

so I will know where add additional

[dlanorh]

8 minutes ago, MS13 said:

Format ( ("old layer name" "new layer name") would be the best as the list is increasing.

Please just put for now

( ("old1" "new1")

( ("old2" "new2")

( ("old3" "new3")

so I will know where add additional

 

It would be far easier to read the layers from a text file rather than keep updating a lisp list. That way you just update the list or lists. 

 

Save the layers in a text file and rename the file extension from "*.txt" to "*.a2b"

Each pair should be on a new line seperated by a comma. e.g.

 

"old_layer1","new_layer1"

"old_layer2","new_layer2"

etc

 

[MS13]

If that seems to be better and easier for you I can go for it

[dlanorh]

(defun c:B2A ( / *error* c_doc lyr_lst ss o_lyr n_lyr)

	(defun *error* ( msg ) 
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
		(princ)
	);_end_*error*_defun

	(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        lyr_lst (list (list "old1" "new1") (list "old2" "new2") (list "old3" "new3") (list "old4" "new4")) ;<<== list of lists (list old layer new layer)
  );end_setq
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(vla-startundomark c_doc)

  (setq ss (ssget "_X"))
  (vlax-for obj (vla-get-activeselectionset c_doc)
    (setq o_lyr (vlax-get-property obj 'layer))
    (cond ( (and (setq n_lyr (cadr (assoc o_lyr lyr_lst)))
                 (tblsearch "layer" n_lyr)
            );end_and     
            (vlax-put-property obj 'layer n_lyr)
          )
          (
           (if (not n_lyr) (princ (strcat "Layer " o_lyr " not found in Layer List.")))
           (if (not (tblsearch "layer" n_lyr)) (princ (strcat "Layer " n_lyr " not found in Drawing.")))          
          )
    );end_cond
  );end_for
  (setq ss nil)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
);end_defun  

In the meantime here is the modified lisp, NOT tested. You can put your layers in where indicated by <<==

Edited October 4, 2018 by dlanorh

[MS13]

Thanks. I am going to test in in near future and let you know

[dlanorh]

2 minutes ago, MS13 said:

Thanks. I am going to test in in near future and let you know

I will post the "read from file" lisp when completed.

[dlanorh]

Attached is the lisp for working with a text file, a sample "a2b" file and a test drawing.

 

Place the "*.a2b" file somewhere outside the autocad support path, the adjust the indicated line "<<======" to refelect the path to the file. Load the drawing and appload the lisp.

Type B2A to run it. The find file dialog should open in the directory with the "*.a2b" file. Select the file and press open. The lisp should complete. You can now have multiple "*.a2b" files which will only copy entities from the old# to the new# layers.

 

In the "*.a2b" file please do not use "" around layer names. Just insert the two layers as shown [old,new]

 

Any problems let me know.

b2a-test.dwg

B2A.lsp

new.a2b

[MS13]

Works like it should.

 

Thanks