Jump to content
Chmcdan211

Move to new layer with suffix

Recommended Posts

Chmcdan211

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

Share this post


Link to post
Share on other sites
BIGAL

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)

Share this post


Link to post
Share on other sites
enthralled
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.

Edited by enthralled
Retain layer properties

Share this post


Link to post
Share on other sites
dlanorh
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?

Share this post


Link to post
Share on other sites
BIGAL

Maybe change the 1 line

 


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

Share this post


Link to post
Share on other sites
pkenewell
Posted (edited)

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)
)

 

Edited by pkenewell
  • Like 1

Share this post


Link to post
Share on other sites
enthralled

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.

Share this post


Link to post
Share on other sites
pkenewell
Posted (edited)
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)
)

 

Edited by pkenewell
  • Like 1

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...