Change Layer and Create New Layer If Needed LISP

May 6, 2016

Hello!

So I've been Googling around the internet and am trying to find a LISP that, upon selecting an object, would place that object on a demo layer and if that layer is not present, would create it.

For example,

If I have a point on the V-NODE-CONC layer, upon selecting it, the LISP would switch it to the "V-NODE-CONC-DEMO" layer. If that layer hasn't yet been created, it would copy the "V-NODE-CONC" LAYER, set it to color 240, and add the "-DEMO" suffix.

Thoughts?

Thanks!

May 6, 2016

Try the following:

(defun c:demo ( / e i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (entget (ssname s (setq i (1- i))))
                 l (assoc 8 x)
                 n (strcat (cdr l) "-DEMO")
           )
           (if (not (tblsearch "layer" n))
               (progn
                   (setq e (entget (tblobjname "layer" (cdr l))))
                   (entmake (subst (cons 2 n) (assoc 2 e) (subst '(62 . 240) (assoc 62 e) e)))
               )
           )
           (entmod (subst (cons 8 n) l x))
       )
   )
   (princ)
)

May 6, 2016

Try the following:

(defun c:demo ( / e i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (entget (ssname s (setq i (1- i))))
                 l (assoc 8 x)
                 n (strcat (cdr l) "-DEMO")
           )
           (if (not (tblsearch "layer" n))
               (progn
                   (setq e (entget (tblobjname "layer" (cdr l))))
                   (entmake (subst (cons 2 n) (assoc 2 e) (subst '(62 . 240) (assoc 62 e) e)))
               )
           )
           (entmod (subst (cons 8 n) l x))
       )
   )
   (princ)
)

Fantastic!

One important thing I forgot to mention, is that I need it to work on Civil 3D points and survey figures when we are demoing a topo drawing.

Sorry about that!

May 6, 2016

Fantastic!

One important thing I forgot to mention, is that I need it to work on Civil 3D points and survey figures when we are demoing a topo drawing.

Sorry about that!

I don't use Civil 3D (or any of the Verticals), but maybe the ActiveX route will enable compatibility with such objects:

(defun c:demo ( / e i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "-DEMO")
           )
           (if (or (tblsearch "layer" n)
                   (and (setq e (entget (tblobjname "layer" l)))
                        (entmake (subst (cons 2 n) (assoc 2 e) (subst '(62 . 240) (assoc 62 e) e)))
                   )
               )
               (vla-put-layer x n)
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

May 6, 2016

I don't use Civil 3D (or any of the Verticals), but maybe the ActiveX route will enable compatibility with such objects:

(defun c:demo ( / e i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "-DEMO")
           )
           (if (or (tblsearch "layer" n)
                   (and (setq e (entget (tblobjname "layer" l)))
                        (entmake (subst (cons 2 n) (assoc 2 e) (subst '(62 . 240) (assoc 62 e) e)))
                   )
               )
               (vla-put-layer x n)
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

It worked for some of the survey figures, but for points and the other survey figures (don't know how there is a difference) I get this..

; error: Automation Error. Key not found

Thanks for the effort Lee Mac! You're the man!

May 6, 2016

Interesting - try the following instead:

(defun c:demo ( / i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "-DEMO")
           )
           (if (checkmakelayer l n) (vla-put-layer x n))
       )
   )
   (princ)
)
(defun checkmakelayer ( a b )
   (cond
       (   (tblsearch "layer" b))
       (   (setq a (tblobjname "layer" a))
           (setq a (entget a))
           (entmake
               (subst (cons 2 b) (assoc 2 a)
                   (subst '(62 . 240) (assoc 62 a)
                       (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                   )
               )
           )
       )
   )
)
(vl-load-com) (princ)

I'm guessing the layer could have an extension dictionary present which may be causing problems when duplicating it.

May 6, 2016

Interesting - try the following instead:

(defun c:demo ( / i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "-DEMO")
           )
           (if (checkmakelayer l n) (vla-put-layer x n))
       )
   )
   (princ)
)
(defun checkmakelayer ( a b )
   (cond
       (   (tblsearch "layer" b))
       (   (setq a (tblobjname "layer" a))
           (setq a (entget a))
           (entmake
               (subst (cons 2 b) (assoc 2 a)
                   (subst '(62 . 240) (assoc 62 a)
                       (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                   )
               )
           )
       )
   )
)
(vl-load-com) (princ)

I'm guessing the layer could have an extension dictionary present which may be causing problems when duplicating it.

HO-LY SHET!! YES!!

I'm going to talk to my boss about kicking down a donation for you.

Thanks Lee Mac!!

May 7, 2016

HO-LY SHET!! YES!!

I'm going to talk to my boss about kicking down a donation for you.

Thanks Lee Mac!!

May 7, 2016

HO-LY SHET!! YES!!

I'm going to talk to my boss about kicking down a donation for you.

Thanks Lee Mac!!

Many thanks Paul! - I'm pleased that the code is working well.

November 21, 2017

Attempting to swap out the suffix of -demo for a prefix sd-; also attempting to maintain the original layers color. However the lisp does nothing.

I have cobbled together the following code:

(defun c:demo ( / i l n s x )
   (if (setq s (ssget "_:L" '((8 . "SD*~"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "SD-")
           )
           (if (checkmakelayer l n) (vla-put-layer x n))
       )
   )
   (princ)
)
(defun checkmakelayer ( a b )
   (cond
       (   (tblsearch "layer" b))
       (   (setq a (tblobjname "layer" a))
           (setq a (entget a))
           (entmake
               (subst (cons 2 b) (assoc 2 a)
                   (subst '(62 . 256) (assoc 62 a)
                       (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                   )
               )
           )
       )
   )
)
(vl-load-com) (princ)

November 21, 2017

Try the following:

(defun c:demo ( / i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~SD-*"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat "SD-" l)
           )
           (if (checkmakelayer l n) (vla-put-layer x n))
       )
   )
   (princ)
)
(defun checkmakelayer ( a b )
   (cond
       (   (tblsearch "layer" b))
       (   (setq a (tblobjname "layer" a))
           (setq a (entget a))
           (entmake
               (subst (cons 2 b) (assoc 2 a)
                   (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
               )
           )
       )
   )
)
(vl-load-com) (princ)

December 1, 2017

Many thanks Dr. Lee

August 13, 2018

Interesting - try the following instead:

(defun c:demo ( / i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "-DEMO")
           )
           (if (checkmakelayer l n) (vla-put-layer x n))
       )
   )
   (princ)
)
(defun checkmakelayer ( a b )
   (cond
       (   (tblsearch "layer" b))
       (   (setq a (tblobjname "layer" a))
           (setq a (entget a))
           (entmake
               (subst (cons 2 b) (assoc 2 a)
                   (subst '(62 . 240) (assoc 62 a)
                       (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                   )
               )
           )
       )
   )
)
(vl-load-com) (princ)

I'm guessing the layer could have an extension dictionary present which may be causing problems when duplicating it.

Hi guys. First post here. I would like to express my admiration to all contributors here. Plenty of usable info posted.

This code works great and I am trying to add some to it. Is it possible to assign the color of the new layer based on the color of the original layer:

If the original layer color is 1 the new layer to be 201; if it is 2 to become 202, etc. for colors from 1 to 8. I assume a loop or condition check has to be added to (subst '(62 . 240) (assoc 62 a) but programming is not my strength.

Thanks

August 13, 2018

Welcome to CADTutor

Try the following quick modification -

(defun c:demo ( / i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "-DEMO")
           )
           (if (checkmakelayer l n) (vla-put-layer x n))
       )
   )
   (princ)
)
(defun checkmakelayer ( a b / c )
   (cond
       (   (tblsearch "layer" b))
       (   (setq a (tblobjname "layer" a))
           (setq a (entget a)
                 c (abs (cdr (assoc 62 a)))
           )
           (entmake
               (subst (cons 2 b) (assoc 2 a)
                   (subst
                       (cons  62 (if (< c 9) (+ c 200) c))
                       (assoc 62 a)
                       (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                   )
               )
           )
       )
   )
)
(vl-load-com) (princ)

August 14, 2018

It works flawlessly. Thank you Lee!

August 14, 2018

You're most welcome!

January 17, 2019

Hi,

I'm having similar problem, I have prepared drawing template with many layers defined by specification, something like this:

first_layer_name
first_layer_name-description1
first_layer_name-description2
first_layer_name-description3
first_layer_name-description4

second_layer_name
second_layer_name-description1
second_layer_name-description2
second_layer_name-description3
second_layer_name-description4

third_layer_name
third_layer_name-description1
third_layer_name-description2
third_layer_name-description3
third_layer_name-description4
...

Description is always same for all layers (currently there are 4 possible variants, like above).

So my job is to go through drawing, select elements in base layer (without description) and change layer to one with description, depending on situation, sometimes it should go to layer with description1, sometimes in others.

I would like to automate this with keyboard shortcuts, something like this: select an element in "first_layer_name" and press "SHIFT+1" and it would go to layer "first_layer_name-description1", with "SHIFT+2" it should go to "first_layer_name-description2" and so on. Lisp should work in other way too (if I make mistake), select an element in "first_layer_name-description2" press "SHIFT+1" and it would go to "first_layer_name-description1".

I figured out how to create keyboard shortcuts - I created macro which runs lisp command and created Shortcut Key for macro and it works, so only problem left is pretty complicated lisp routine.

March 30, 2023

On 8/13/2018 at 6:31 PM, Lee Mac said:

Welcome to CADTutor

Try the following quick modification -

(defun c:demo ( / i l n s x )
   (if (setq s (ssget "_:L" '((8 . "~*-DEMO"))))
       (repeat (setq i (sslength s))
           (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                 l (vla-get-layer x)
                 n (strcat l "-DEMO")
           )
           (if (checkmakelayer l n) (vla-put-layer x n))
       )
   )
   (princ)
)
(defun checkmakelayer ( a b / c )
   (cond
       (   (tblsearch "layer" b))
       (   (setq a (tblobjname "layer" a))
           (setq a (entget a)
                 c (abs (cdr (assoc 62 a)))
           )
           (entmake
               (subst (cons 2 b) (assoc 2 a)
                   (subst
                       (cons  62 (if (< c 9) (+ c 200) c))
                       (assoc 62 a)
                       (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                   )
               )
           )
       )
   )
)
(vl-load-com) (princ)

@Lee Mac is there a way to reverse this command so that it removes "-DEMO" and reverts it to the original layer? Thank you!

March 31, 2023

22 hours ago, Pichael said:

@Lee Mac is there a way to reverse this command so that it removes "-DEMO" and reverts it to the original layer? Thank you!

Sure - try the following:

(defun c:demo ( / i l n s x )
    (if (setq s (ssget "_:L" '((8 . "?*-DEMO"))))
        (repeat (setq i (sslength s))
            (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                  l (vla-get-layer x)
                  n (substr l 1 (- (strlen l) 5))
            )
            (if (checkmakelayer l n) (vla-put-layer x n))
        )
    )
    (princ)
)
(defun checkmakelayer ( a b / c )
    (cond
        (   (tblsearch "layer" b))
        (   (setq a (tblobjname "layer" a))
            (setq a (entget a)
                  c (abs (cdr (assoc 62 a)))
            )
            (entmake
                (subst (cons 2 b) (assoc 2 a)
                    (subst
                        (cons  62 (if (< c 9) (+ c 200) c))
                        (assoc 62 a)
                        (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                    )
                )
            )
        )
    )
)
(vl-load-com) (princ)

October 3

Hello Lee,

was needing some help and I hope you can help me. I worte this routine to help me move cogo points from one layer to another (from whatever object layer the item i pick is on, it will move it to V-XNODE-TOPO. It works for text and lines but "entmod" will not work on C3d Points. What am I missing here? Thank you.

(defun c:clyr (/ )
(setq data (entget (car (entsel "\nSelect object to move to layer V-XNODE-TOPO\n"))))
(setq ndata (subst (cons 8 "V-XNODE-TOPO")(assoc 8 data) data))
(entmod ndata)

Sign In

Change Layer and Create New Layer If Needed LISP

Recommended Posts

PaulS00

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Lee Mac

Lee Mac

PaulS00

Lee Mac

PaulS00

Lee Mac

PaulS00

Dadgad

Lee Mac

capnsjules

Lee Mac

troggarf

d1saster

Lee Mac

d1saster

Lee Mac

phidrho

Pichael

Lee Mac

Uriel El Gordo

Join the conversation

Lee Mac

Tutorials

Forums

Activity