Move to new layer with suffix

All,

I would like to know if anyone knows of a lisp that will do this.

1. Copy the layer of a selected object (4"-HG-BC38-9100)

2. Add a suffix to the end of that layer (-UG)

3. Move only the selected object to that new layer (4"-HG-BC38-9100-UG)

I have made a lisp that will add a suffix to the selected layer, however I can't figure out how to keep all other objects on the original layer and move the selected object to a layer of the same name with a suffix.

EX. objects are created on layer 4"-HG-BC38-9100

I want the lisp and select an object that is on that layer and have the lisp copy that layer, add a -UG suffix to it and move only the selected object to layer 4"-HG-BC38-9100-UG

I think that makes sense...

Chris

There are different ways to do it, but using simple lisp

; simple version
(defun C:test ( / obj layname suff)
(setq obj (entsel))
(setq layname (cdr (assoc 8 (entget (car obj)))))
(setq suff (getstring " Enter suffix"))
(setq layname (strcat layname suff))
(command "-layer" "N" layname "")
(command "CHPROP" obj "" "LA" layname "") 
)
(c:TEST)

On 4/17/2015 at 5:47 AM, BIGAL said:

There are different ways to do it, but using simple lisp

 

 

; simple version
(defun C:test ( / obj layname suff)
(setq obj (entsel))
(setq layname (cdr (assoc 8 (entget (car obj)))))
(setq suff (getstring " Enter suffix"))
(setq layname (strcat layname suff))
(command "-layer" "N" layname "")
(command "CHPROP" obj "" "LA" layname "") 
)
(c:TEST)

 

 

Can this be made to work for a selection of multiple objects of different layers? Currently it only works for single object selection.

Edit: It would be much helpful if the newly created layer (with the suffix) keeps the properties of the original layer (Color, line W and type...). As it is now it resets the layer properties.

1 hour ago, enthralled said:

Can this be made to work for a selection of multiple objects of different layers? Currently it only works for single object selection.

Edit: It would be much helpful if the newly created layer (with the suffix) keeps the properties of the original layer (Color, line W and type...). As it is now it resets the layer properties.

The simple version above uses the layer of the selected object as the base for the new layer. How would this work if you are selecting multiple objects on multiple layers?

Maybe change the 1 line

(command "CHPROP" obj "" "LA" layname "") 
(command "CHPROP" (ssget) "" "LA" layname "") 

Try one of these 2 functions. The 1st one (TEST2) just renames the layers. The 2nd one (TEST3) creates new layers and moves the selection to the new layers (Note - Currently the color and linetypes  of the original layers are not replicated in TEST3).

(defun C:test2 ( / cnt el la llst nlst ss suff)
   (setq ss (ssget) cnt 0)
   (repeat (sslength ss)
       (setq el (entget (ssname ss cnt))
             la (cdr (assoc 8 el))
             cnt (1+ cnt)
       )
       (if (not (member la llst))(setq llst (cons la llst)))
   )
   (if (setq suff (getstring "\nEnter suffix for layers: "))
      (progn
         (setq nlst (mapcar '(lambda (x) (strcat x "-" suff)) llst) cnt 0)
         (foreach i llst
            (command "._-rename" "_LA" i (nth cnt nlst))
            (setq cnt (1+ cnt))
         )
      )
   )
   (princ)
)

(defun C:test3 ( / cnt el en la llst nlst ss suff)
   (setq ss (ssget) cnt 0)
   (repeat (sslength ss)
       (setq el (entget (ssname ss cnt))
             la (cdr (assoc 8 el))
             cnt (1+ cnt)
       )
       (if (not (member la llst))(setq llst (cons la llst)))
   )
   (if (setq suff (getstring "\nEnter suffix for layers: "))
      (progn
         (setq nlst (mapcar '(lambda (x) (strcat x "-" suff)) llst) cnt 0)
         (foreach i nlst
            (command "._-layer" "_N" i "")
            (setq cnt (1+ cnt))
         )
         (setq cnt 0)
         (repeat (sslength ss)
             (setq en (ssname ss cnt)
                   el (entget en)
                   la (cdr (assoc 8 el))
                   el (subst (cons 8 (strcat la "-" suff)) (assoc 8 el) el)
                   cnt (1+ cnt)
             )
             (entmod el)
         )
      )
   )
   (princ)
)

To preserve original layer properties, I'm currently cutting the objects to a new dwg, rename the layers with required suffix, then cut and paste back into the original drawing.

10 hours ago, enthralled said:

To preserve original layer properties, I'm currently cutting the objects to a new dwg, rename the layers with required suffix, then cut and paste back into the original drawing.

Try this revision to my TEST3 command. It currently only reads the ACI color codes from the original layers, but could be updated to capture the other color codes (truecolor, colorbook) as well. Let me know if that is necessary.

(defun C:test3 ( / cl cnt el en la llst lt nlst ol suff)
   (setq ss (ssget) cnt 0)
   (repeat (sslength ss)
       (setq el (entget (ssname ss cnt))
             la (cdr (assoc 8 el))
             cnt (1+ cnt)
       )
       (if (not (member la llst))(setq llst (cons la llst)))
   )
   (if (setq suff (getstring "\nEnter suffix for layers: "))
      (progn
         (setq nlst (mapcar '(lambda (x) (strcat x "-" suff)) llst) cnt 0)
         (foreach i nlst
            (setq ol (tblsearch "LAYER" (nth 1 llst))
                  cl (cdr (assoc 62 ol))
                  lt (cdr (assoc  6 ol))
            )
            (command "._-layer" "_N" i "_c" cl i "_l" lt i "")

            (setq cnt (1+ cnt))
         )
         (setq cnt 0)
         (repeat (sslength ss)
             (setq en (ssname ss cnt)
                   el (entget en)
                   la (cdr (assoc 8 el))
                   el (subst (cons 8 (strcat la "-" suff)) (assoc 8 el) el)
                   cnt (1+ cnt)
             )
             (entmod el)
         )
      )
   )
   (princ)
)