duplicate layer

Does anyone have a lisp routine that allows the user to make a duplicate of
a layer and everything that exists on that layer?

 

Yep! Although it will only work in the current tab......

Jeff

(defun c:dup-lay (/ ent lay newlay lastent ss1 ss2 laylist)
(if (setq ent (entsel "\nSelect entity on layer to duplicate: "))
(progn
(setq lay (cdr (assoc 8 (entget (car ent))))
newlay (strcat lay "-DUPLICATE")
lastent (entlast))
(if (setq ss1 (ssget "x" (list (cons 8 lay))))
(progn
(setq laylist (entget (tblobjname "layer" lay))
laylist (subst (cons 2 newlay)
(assoc 2 laylist) laylist))
(entmake laylist)
(command "copy" ss1 "" "0,0" "0,0")
(setq ss2 (ssadd))
(while (setq lastent (entnext lastent))
(ssadd lastent ss2)
)
(command "chprop" ss2 "" "la" newlay "")
)
)
)
)
(princ)
)

 

This one just copies all from layername to 'copyof'layername.
You may want to add tabs..

;; dup_layer
(defun C:dup_layer ()
(setq lname (getstring "\nLayer Name to Duplicate ?"))
(setq new_lname (strcat "COPYOF" lname))
(if (tblsearch "layer" lname)
(progn
(setq ss (ssget "X" (list (cons 8 lname))))
(command "_layer" "_m" new_lname "")
(command "_layer" "_s" new_lname "")
(if (/= ss nil)
(progn
(command "_copy" "prev" "" "0,0" "0,0")
(command "_change" "prev" "" "_p" "_la" new_lname "")
); progn
); end if
); end progn
(prompt (strcat "\nCould not find " lname " Layer ?"))
); end if
(command "_layer" "_s" "0" ""); reset to 0
(princ)
); end function

Cheers
Bob

 

I wonder if nested objects are a concern?

 

No, I just want to make a copy of everything that is on a layer and put it
on a new layer.

 

Interesting, I didn't even think about the current tab. I think I would
want to work in all tabs.

 

Thanks Bob, I'll have to give it a go.

 

hmmmmm nested objects, I'm not to concerned with nested objects right now.
But you bring up a great point.

 

OK, that's what I thought, too. And I figured out how to do it. Here's
one that will make an exact copy of a layer, regardless of space or
tabs.

Jeff

(defun c:dup-lay (/ ent lay newlay ss1 laylist newent)
(if (setq ent (entsel "\nSelect entity on layer to duplicate: "))
(progn
(setq lay (cdr (assoc 8 (entget (car ent))))
newlay (strcat lay "-DUPLICATE")
)
(if (setq ss1 (ssget "x" (list (cons 8 lay))))
(progn
(setq laylist (entget (tblobjname "layer" lay))
laylist (subst (cons 2 newlay)
(assoc 2 laylist)
laylist
)
)
(entmake laylist)
(setq count -1)
(while (< (setq count (1+ count)) (sslength ss1))
(setq newent (vla-copy (vlax-ename->vla-object (ssname ss1
count))))
(vla-put-layer newent newlay)
)
)
)
)
)
(princ)
)