Update to lisp to create and add prefix or suffix to selected layers a set number of times

[andyb57J]

I currently use the attached lisp to add a suffix (generally Staging layer numbers) or prefix to selected layers within a drawing so that each item within a stage is on its own layer so that they can be set to not visible with plans not within a set stage.  This works fine where developments have a minimum number of stages but I was wondering if someone could modify it so that the user can set the number of stages and the lisp will then create all the necessary layers in one go.  The initial layers are generally shown as

 

 

With the updated layers having the identifying Stage no as a prefix.

 

Is it possible to update the lisp so that the user can set the number of Stages (ie 1 - 32) and the lisp to then create all the stage layers at one time.

 

I have included a dwg file which may assist.

 

(defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl pr ss su tr)
   
   (vl-load-com)
   (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         lyrs  (vla-get-layers acdoc)
   )
   (vla-StartUndoMark AcDoc)

   (if (and
         (setq ss (ssget ":L"))
         (setq pr (getstring T "\nEnter Prefix for new layers from selected objects <ENTER for None>: "))
         (setq su (getstring T "\nEnter suffix for new layers from selected objects <ENTER for None>: "))
         (not (= pr su ""))
       )
       (progn
         (repeat (setq cnt (sslength ss))
            (setq el (entget (ssname ss (setq cnt (1- cnt))))
                  la (cdr (assoc 8 el))
            )
            (if (not (member la llst))(setq llst (cons la llst)))
         )
         (setq cnt 0)
         (foreach n llst
            (if (not (tblsearch "LAYER" (strcat pr n su)))
               (progn
                  (setq ob  (vlax-ename->vla-object (setq el (tblobjname "LAYER" n)))
                        col (vla-get-truecolor  ob)
                        lt  (vla-get-linetype   ob)
                        lw  (vla-get-lineweight ob)
                        np  (vla-get-plottable  ob)
                        nl  (vla-add lyrs (strcat pr (vla-get-name ob) su))
                        tr  (getpropertyvalue el "Transparency")
                  )
                  (vla-put-truecolor  nl col)
                  (vla-put-linetype   nl lt)
                  (vla-put-lineweight nl lw)
                  (vla-put-plottable  nl np)
                  (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr)
                  (if (tblsearch "LAYER" (strcat pr n su))(setq cnt (1+ cnt)))
               )
            )
         )
         (if (> cnt 0)(princ (strcat "\n(" (itoa cnt) ") New Layers Created.")))
      )
      (if (= pr su "")(princ "\nNo Suffix or Prefix Given - No new layers created."))
   )

   (vla-EndUndoMark AcDoc)
   (princ)
)
(princ)

 

CNL.lsp Test.dwg

[pkenewell]

@andyb57J

Sure - Give this a try:

 

EDIT: This sets s sequential number. But I think I mis-understood. I'll take a look at your drawing and update.

EDIT: Corrected code below. Let me know if I am still mis-interpreting.

(defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl pr seq ss su tr)
   
   (vl-load-com)
   (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         lyrs  (vla-get-layers acdoc)
   )
   (vla-StartUndoMark AcDoc)

   (if (and
         (setq ss (ssget ":L"))
         (setq pr (getstring T "\nEnter Prefix for new layers from selected objects <ENTER for None>: "))
         (setq su (getstring T "\nEnter suffix for new layers from selected objects <ENTER for None>: "))
         (not (= pr su ""))
       )
       (progn
         (initget "Yes No")
         (if (= (getkword "\nAdd a Stage number to the Prefix? [Yes/No] <No>: ") "Yes")
            (if (not (setq seq (getint "\Stage Number <1>: "))) (setq seq 1))
         )
         (repeat (setq cnt (sslength ss))
            (setq el (entget (ssname ss (setq cnt (1- cnt))))
                  la (cdr (assoc 8 el))
            )
            (if (not (member la llst))(setq llst (cons la llst)))
         )
         (setq cnt 0)
         (foreach n llst
            (if (not (tblsearch "LAYER" (strcat pr (if seq (itoa seq) "") n su)))
               (progn
                  (setq ob  (vlax-ename->vla-object (setq el (tblobjname "LAYER" n)))
                        col (vla-get-truecolor  ob)
                        lt  (vla-get-linetype   ob)
                        lw  (vla-get-lineweight ob)
                        np  (vla-get-plottable  ob)
                        nl  (vla-add lyrs (strcat (if seq (strcat pr (Itoa seq)) pr) (vla-get-name ob) su))
                        tr  (getpropertyvalue el "Transparency")
                        ;seq (if seq (1+ seq))
                  )
                  (vla-put-truecolor  nl col)
                  (vla-put-linetype   nl lt)
                  (vla-put-lineweight nl lw)
                  (vla-put-plottable  nl np)
                  (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr)
                  (if (tblsearch "LAYER" (strcat pr n su))(setq cnt (1+ cnt)))
               )
            )
         )
         (if (> cnt 0)(princ (strcat "\n(" (itoa cnt) ") New Layers Created.")))
      )
      (if (= pr su "")(princ "\nNo Suffix or Prefix Given - No new layers created."))
   )

   (vla-EndUndoMark AcDoc)
   (princ)
)
(princ)

 

Edited June 9 by pkenewell

[andyb57J]

2 hours ago, pkenewell said:

@andyb57J

Sure - Give this a try:

 

EDIT: This sets s sequential number. But I think I mis-understood. I'll take a look at your drawing and update.

EDIT: Corrected code below. Let me know if I am still mis-interpreting.

(defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl pr seq ss su tr)
   
   (vl-load-com)
   (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         lyrs  (vla-get-layers acdoc)
   )
   (vla-StartUndoMark AcDoc)

   (if (and
         (setq ss (ssget ":L"))
         (setq pr (getstring T "\nEnter Prefix for new layers from selected objects <ENTER for None>: "))
         (setq su (getstring T "\nEnter suffix for new layers from selected objects <ENTER for None>: "))
         (not (= pr su ""))
       )
       (progn
         (initget "Yes No")
         (if (= (getkword "\nAdd a Stage number to the Prefix? [Yes/No] <No>: ") "Yes")
            (if (not (setq seq (getint "\Stage Number <1>: "))) (setq seq 1))
         )
         (repeat (setq cnt (sslength ss))
            (setq el (entget (ssname ss (setq cnt (1- cnt))))
                  la (cdr (assoc 8 el))
            )
            (if (not (member la llst))(setq llst (cons la llst)))
         )
         (setq cnt 0)
         (foreach n llst
            (if (not (tblsearch "LAYER" (strcat pr (if seq (itoa seq) "") n su)))
               (progn
                  (setq ob  (vlax-ename->vla-object (setq el (tblobjname "LAYER" n)))
                        col (vla-get-truecolor  ob)
                        lt  (vla-get-linetype   ob)
                        lw  (vla-get-lineweight ob)
                        np  (vla-get-plottable  ob)
                        nl  (vla-add lyrs (strcat (if seq (strcat pr (Itoa seq)) pr) (vla-get-name ob) su))
                        tr  (getpropertyvalue el "Transparency")
                        ;seq (if seq (1+ seq))
                  )
                  (vla-put-truecolor  nl col)
                  (vla-put-linetype   nl lt)
                  (vla-put-lineweight nl lw)
                  (vla-put-plottable  nl np)
                  (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr)
                  (if (tblsearch "LAYER" (strcat pr n su))(setq cnt (1+ cnt)))
               )
            )
         )
         (if (> cnt 0)(princ (strcat "\n(" (itoa cnt) ") New Layers Created.")))
      )
      (if (= pr su "")(princ "\nNo Suffix or Prefix Given - No new layers created."))
   )

   (vla-EndUndoMark AcDoc)
   (princ)
)
(princ)

 

Thankyou for the effort but I don't think I explained myself well enough.  What I was hoping for was that if I required, for example, 32 stages that the lisp would create all the layers selected by adding the prefix Stage 1 through to Stage 32 so in effect creating over 500 odd layers.  Each selected layer would have the prefix.  Perhaps the user could input a start no (i.e 1) and the last stage no. (i.e 32) and the lisp would automatically add the prefix from 1 to 32 to all the selected layers.

[pkenewell]

1 hour ago, andyb57J said:

Thankyou for the effort but I don't think I explained myself well enough.  What I was hoping for was that if I required, for example, 32 stages that the lisp would create all the layers selected by adding the prefix Stage 1 through to Stage 32 so in effect creating over 500 odd layers.  Each selected layer would have the prefix.  Perhaps the user could input a start no (i.e 1) and the last stage no. (i.e 32) and the lisp would automatically add the prefix from 1 to 32 to all the selected layers.

@andyb57J

 Ok I understand. Questions:

1) is the prefix separate; to still be prompted for, or is just "STAGE" always the prefix? Or both?

2) Still prompt for Suffix?

3) Do you always want a SPACE between the "STAGE" and the number?

Edited June 9 by pkenewell

[pkenewell]

OK - since I need to put something down before I head home, this code will do optionally Prefix, Suffix and/or stage numbers. I'll tune it closer to what you want with your feedback to my questions.

(defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl pr rp seq ss su tr)
   
   (vl-load-com)
   (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         lyrs  (vla-get-layers acdoc)
   )
   (vla-StartUndoMark AcDoc)

   (if (and
         (setq ss (ssget ":L"))
         (setq pr (getstring T "\nEnter Prefix for new layers from selected objects <ENTER for None>: "))
         (setq su (getstring T "\nEnter suffix for new layers from selected objects <ENTER for None>: "))
       )
       (progn
         (initget "Yes No")
         (if (= (getkword "\nAdd Stage numbers? [Yes/No] <No>: ") "Yes")
            (progn   
               (while (> (setq seq (getint "\Number of Stages [1-32] <32>: ")) 32)
                  (princ "\nNo more than 32 stages can be specified.")
               )
               (if (not seq)(setq seq 32))
            )
         )
         (repeat (setq cnt (sslength ss))
            (setq el (entget (ssname ss (setq cnt (1- cnt))))
                  la (cdr (assoc 8 el))
            )
            (if (not (member la llst))(setq llst (cons la llst)))
         )
         (setq cnt 0 rp 1)
         (foreach n llst
            (if (not (tblsearch "LAYER" (strcat (if seq (strcat "STAGE " (itoa rp)) "") pr n su)))
               (progn
                  (setq ob  (vlax-ename->vla-object (setq el (tblobjname "LAYER" n)))
                        col (vla-get-truecolor  ob)
                        lt  (vla-get-linetype   ob)
                        lw  (vla-get-lineweight ob)
                        np  (vla-get-plottable  ob)
                        tr  (getpropertyvalue el "Transparency")
                        rp  1
                  )
                  (repeat (if seq seq 1)
                     (setq nl (vla-add lyrs (strcat (if seq (strcat "STAGE " (Itoa rp) pr) pr) (vla-get-name ob) su))
                           rp (if seq (1+ rp))
                     )
                     (vla-put-truecolor  nl col)
                     (vla-put-linetype   nl lt)
                     (vla-put-lineweight nl lw)
                     (vla-put-plottable  nl np)
                     (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr)
                  )
                  (setq cnt (1+ cnt))
               )
            )
         )
         (if (> cnt 0)(princ (strcat "\n(" (itoa (* cnt (if seq seq 1))) ") New Layers Created.")))
      )
      (if (= pr su "")(princ "\nNo Suffix or Prefix Given - No new layers created."))
   )

   (vla-EndUndoMark AcDoc)
   (princ)
)
(princ)

 

There is probably a more efficient way logically to lay this out. I can hash that out later but this works in my testing.

[andyb57J]

2 hours ago, pkenewell said:

OK - since I need to put something down before I head home, this code will do optionally Prefix, Suffix and/or stage numbers. I'll tune it closer to what you want with your feedback to my questions.

(defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl pr rp seq ss su tr)
   
   (vl-load-com)
   (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         lyrs  (vla-get-layers acdoc)
   )
   (vla-StartUndoMark AcDoc)

   (if (and
         (setq ss (ssget ":L"))
         (setq pr (getstring T "\nEnter Prefix for new layers from selected objects <ENTER for None>: "))
         (setq su (getstring T "\nEnter suffix for new layers from selected objects <ENTER for None>: "))
       )
       (progn
         (initget "Yes No")
         (if (= (getkword "\nAdd Stage numbers? [Yes/No] <No>: ") "Yes")
            (progn   
               (while (> (setq seq (getint "\Number of Stages [1-32] <32>: ")) 32)
                  (princ "\nNo more than 32 stages can be specified.")
               )
               (if (not seq)(setq seq 32))
            )
         )
         (repeat (setq cnt (sslength ss))
            (setq el (entget (ssname ss (setq cnt (1- cnt))))
                  la (cdr (assoc 8 el))
            )
            (if (not (member la llst))(setq llst (cons la llst)))
         )
         (setq cnt 0 rp 1)
         (foreach n llst
            (if (not (tblsearch "LAYER" (strcat (if seq (strcat "STAGE " (itoa rp)) "") pr n su)))
               (progn
                  (setq ob  (vlax-ename->vla-object (setq el (tblobjname "LAYER" n)))
                        col (vla-get-truecolor  ob)
                        lt  (vla-get-linetype   ob)
                        lw  (vla-get-lineweight ob)
                        np  (vla-get-plottable  ob)
                        tr  (getpropertyvalue el "Transparency")
                        rp  1
                  )
                  (repeat (if seq seq 1)
                     (setq nl (vla-add lyrs (strcat (if seq (strcat "STAGE " (Itoa rp) pr) pr) (vla-get-name ob) su))
                           rp (if seq (1+ rp))
                     )
                     (vla-put-truecolor  nl col)
                     (vla-put-linetype   nl lt)
                     (vla-put-lineweight nl lw)
                     (vla-put-plottable  nl np)
                     (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr)
                  )
                  (setq cnt (1+ cnt))
               )
            )
         )
         (if (> cnt 0)(princ (strcat "\n(" (itoa (* cnt (if seq seq 1))) ") New Layers Created.")))
      )
      (if (= pr su "")(princ "\nNo Suffix or Prefix Given - No new layers created."))
   )

   (vla-EndUndoMark AcDoc)
   (princ)
)
(princ)

 

There is probably a more efficient way logically to lay this out. I can hash that out later, but this works in my testing.

Thankyou.  This is perfect.  Only thing I would add is an underscore after the Stage no.  I have addressed your other queries to provide the results but can't wok out where to put the underscore so it appears after the stage no.

 

This lisp will most likely only be used to create the stage no layers so the prefix and suffix part will not be required.  If I need those, I still have the original lisp.

 

 

[ronjonp]

@andyb57J

Here's another way to do it using entmakex. I hardcoded the 'STAGE' prefix:
 

(defun c:cnl (/ cnt el i la llst ss)
  (if (and (setq ss (ssget)) (> (setq i (getint "\nEnter number of stages: ")) 0))
    (progn (repeat (setq cnt (sslength ss))
	     (setq el (entget (ssname ss (setq cnt (1- cnt))))
		   la (cdr (assoc 8 el))
	     )
	     (or (member la llst) (setq llst (cons la llst)))
	   )
	   (foreach n llst
	     (setq cnt 0)
	     (repeat i
	       (setq el (entget (tblobjname "LAYER" n) '("*")))
	       (entmakex
		 (subst (cons 2 (strcat "STAGE " (itoa (setq cnt (1+ cnt))) "_" n)) (assoc 2 el) el)
	       )
	     )
	   )
    )
  )
  (princ)
)

 

Edited June 12 by ronjonp

[andyb57J]

1 hour ago, ronjonp said:

@andyb57J

Here's another way to do it using entmakex. I hardcoded the 'STAGE' prefix:
 

(defun c:cnl (/ cnt el i la llst ss)
  (if (and (setq ss (ssget)) (> (setq i (getint "\nEnter number of stages: ")) 0))
    (progn (repeat (setq cnt (sslength ss))
	     (setq el (entget (ssname ss (setq cnt (1- cnt))))
		   la (cdr (assoc 8 el))
	     )
	     (or (member la llst) (setq llst (cons la llst)))
	   )
	   (foreach n llst
	     (setq cnt 0)
	     (repeat i
	       (setq el (entget (tblobjname "LAYER" n) '("*")))
	       (entmakex
		 (subst (cons 2 (strcat "STAGE " (itoa (setq cnt (1+ cnt))) "_" n)) (assoc 2 el) el)
	       )
	     )
	   )
    )
  )
  (princ)
)
(princ)

 

Thankyou.  Exactly what I needed

[ronjonp]

1 hour ago, andyb57J said:

Thankyou.  Exactly what I needed

[pkenewell]

14 hours ago, andyb57J said:

This lisp will most likely only be used to create the stage no layers so the prefix and suffix part will not be required.  If I need those, I still have the original lisp.

 

@andyb57J

Ok - to be Thorough FWIW, here is your original code rearranged to only do the Stage numbers:

(defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl rp seq ss tr)
   
   (vl-load-com)
   (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         lyrs  (vla-get-layers acdoc)
   )
   (vla-StartUndoMark AcDoc)

   (if (setq ss (ssget ":L"))
       (progn
         (while (> (setq seq (getint "\Number of Stages [1-32] <32>: ")) 32)
            (princ "\nNo more than 32 stages can be specified.")
         )
         (if (not seq)(setq seq 32))
         (repeat (setq cnt (sslength ss))
            (setq el (entget (ssname ss (setq cnt (1- cnt))))
                  la (cdr (assoc 8 el))
            )
            (if (not (member la llst))(setq llst (cons la llst)))
         )
         (setq cnt 0)
         (foreach n llst
            (setq rp 1)
            (setq ob  (vlax-ename->vla-object (setq el (tblobjname "LAYER" n)))
                  col (vla-get-truecolor  ob)
                  lt  (vla-get-linetype   ob)
                  lw  (vla-get-lineweight ob)
                  np  (vla-get-plottable  ob)
                  tr  (getpropertyvalue el "Transparency")
            )
            (repeat seq
               (if (not (tblsearch "LAYER" (strcat "STAGE " (itoa rp) "_" n)))
                  (progn
                     (setq nl (vla-add lyrs (strcat "STAGE " (itoa rp) "_" n))
                           rp (if seq (1+ rp))
                     )
                     (vla-put-truecolor  nl col)
                     (vla-put-linetype   nl lt)
                     (vla-put-lineweight nl lw)
                     (vla-put-plottable  nl np)
                     (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr)
                  )
               )
            )
            (setq cnt (1+ cnt))
         )
         (if (> cnt 0)(princ (strcat "\n(" (itoa (* cnt seq)) ") New Layers Created.")))
      )
   )

   (vla-EndUndoMark AcDoc)
   (princ)
)
(princ)

 

Edited June 10 by pkenewell

[andyb57J]

On 10/06/2025 at 20:55, pkenewell said:

 

@andyb57J

Ok - to be Thorough FWIW, here is your original code rearranged to only do the Stage numbers:

(defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl rp seq ss tr)
   
   (vl-load-com)
   (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         lyrs  (vla-get-layers acdoc)
   )
   (vla-StartUndoMark AcDoc)

   (if (setq ss (ssget ":L"))
       (progn
         (while (> (setq seq (getint "\Number of Stages [1-32] <32>: ")) 32)
            (princ "\nNo more than 32 stages can be specified.")
         )
         (if (not seq)(setq seq 32))
         (repeat (setq cnt (sslength ss))
            (setq el (entget (ssname ss (setq cnt (1- cnt))))
                  la (cdr (assoc 8 el))
            )
            (if (not (member la llst))(setq llst (cons la llst)))
         )
         (setq cnt 0)
         (foreach n llst
            (setq rp 1)
            (setq ob  (vlax-ename->vla-object (setq el (tblobjname "LAYER" n)))
                  col (vla-get-truecolor  ob)
                  lt  (vla-get-linetype   ob)
                  lw  (vla-get-lineweight ob)
                  np  (vla-get-plottable  ob)
                  tr  (getpropertyvalue el "Transparency")
            )
            (repeat seq
               (if (not (tblsearch "LAYER" (strcat "STAGE " (itoa rp) "_" n)))
                  (progn
                     (setq nl (vla-add lyrs (strcat "STAGE " (itoa rp) "_" n))
                           rp (if seq (1+ rp))
                     )
                     (vla-put-truecolor  nl col)
                     (vla-put-linetype   nl lt)
                     (vla-put-lineweight nl lw)
                     (vla-put-plottable  nl np)
                     (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr)
                  )
               )
            )
            (setq cnt (1+ cnt))
         )
         (if (> cnt 0)(princ (strcat "\n(" (itoa (* cnt seq)) ") New Layers Created.")))
      )
   )

   (vla-EndUndoMark AcDoc)
   (princ)
)
(princ)

 

Thankyou