Jump to content

Add Prefix or suffix to all layers in a drawing


gman

Recommended Posts

You might be able to accomplish with the "rename" command. In the RENAME dialogue box, for old layer name enter "*" to apply to all layers, then "Prefix*" or "*Suffix" for the new name.

Link to comment
Share on other sites

I have made a small VBA function to do that but don't know how to upload here. It has a form and coding.


Private Sub cmbList_Change()
Dim ans As String, Lay As AcadLayer
Dim LayName As String
ans = cmbList.Text
Select Case ans
Case "Layer"
For Each Lay In ThisDrawing.Layers
   LayName = Lay.Name
   lstPrimList.AddItem (LayName)
Next
Case Else
MsgBox "No other "
End Select
End Sub

Private Sub cmdDoit_Click()
Dim i As Long, K As Long
Dim Lay As AcadLayer
For i = 0 To lstImport.ListCount - 1
   For Each Lay In ThisDrawing.Layers
       If Lay.Name = lstImport.List(i) Then
           If tbxSuffix.Text <> "" Then
               Lay.Name = tbxSuffix.Text & "-" & Lay.Name
           End If
           If tbxPrefix.Text <> "" Then
               Lay.Name = Lay.Name & "-" & tbxPrefix.Text
           End If
       End If
   Next
Next i
Unload Me
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdImport_Click()
Dim i As Long, boolVar As Boolean, K As Long
If lstPrimList.ListCount > 0 Then
   For i = 0 To lstPrimList.ListCount - 1
        boolVar = lstPrimList.Selected(i)
        If boolVar = True Then
           If lstPrimList.List(i) <> "0" Then
               lstImport.AddItem (lstPrimList.List(i))
           End If
      
       
        End If
   Next i
Else
   MsgBox "Select atleast an item from the above list"
End If
End Sub

Private Sub UserForm_Initialize()
cmbList.AddItem ("Layer")
cmbList.AddItem ("Block")
cmbList.AddItem ("Dim Style")
cmbList.AddItem ("Styles")

End Sub

window looks like this

my.php?image=screenshotqm4.jpg

Link to comment
Share on other sites

You also can try this:

(defun c:layrename (/ adoc str)
 (vl-load-com)
 (initget "Prefix Suffix _ P S")
 (setq    adoc   (vla-get-activedocument (vlax-get-acad-object))
   answer (getkword "\nUse string like [Prefix/Suffix] <Prefix> : ")
   str    (getstring "\nString to add <Exit> : ")
   ) ;_ end of setq
 (vla-startundomark adoc)
 (if (not answer)
   (setq answer "P")
   ) ;_ end of if
 (vlax-for item (vla-get-layers adoc)
   (vl-catch-all-apply
     'vla-put-name
     (list
   item
   (cond
     ((= answer "P")
      (strcat str (vla-get-name item))
      )
     (t
      (strcat (vla-get-name item) str)
      )
     ) ;_ end of cond
   ) ;_ end of list
     ) ;_ end of VL-CATCH-ALL-APPLY
   ) ;_ end of vlax-for
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

Link to comment
Share on other sites

  • 6 months later...

This is a nice routine. Can you make it to where you can select a layer or touch and object and just make the sufix default to -extg or whatever you want to put as a sufix. We are using aia standards, so we would only need to to add a sufix of -extg or -demo etc..

Link to comment
Share on other sites

it is very usefull lisp

but i think it will be more usefull and practical if it work like that:

command:select layer(by clicking on object in the drawing)

the name of layer a ppear in the command line

then select another layer buy clicking another object

then click enter to end selection

command: enter suffix or prefix to be added to selected layers names

then all seclected layers name changed

thanks

Link to comment
Share on other sites

this is what I use now but it requires all 4 lisp routines. I there a way to do the same thing with either a macro or a shorter lisp. This is the way I have my button now.

^C^C(load"NMELIST");(load"NCLTLIST");(load"ustr");(load"layerextg");^C^Clayrn;

 

Routine 1

 

;THIS ROUTINE WILL RENAME ALL THE LAYERS IN A DRAWING

;TO BE PREFIXED WITH USER SELECTED sufFIX DEFAULT "_BAK".

;TO AID IN INSERTING BAKGROUNDS

;

;ONE WAY TO USE IT IS TO INSERT THE BACKGROUND FROM THE

;ARCHITECT. COPY ALL ENTITIES

 

(defun c:layrn()

(setq LsuffIX (ustr 1 "Enter layer suffix " "-extg" nil))

(if (not ncltlist)(load "ncltlist"))

(setq STUFF (ncltlist)

LAYLIST (car STUFF)

ENTS (cadr STUFF)

CNTR 0

)

(foreach LAYDAT LAYLIST (progn

(setq LAYNME2 (strcat (car LAYDAT) LsufFIX))

(command "layer" "m" LAYNME2 "C" (cadr LAYDAT) "" "lt" (caddr LAYDAT) "" "")

(prompt "-")

)

)

(SETQ ALIS (SSGET))

(COMMAND "CHANGE" ALIS "" "P" "LT" "hidden2" "C" "13" "")

(repeat (sslength ENTS)

(setq ENTDAT

(subst

(cons 8

(strcat

(cdr

(setq OLD

(assoc 8

(setq ENTDAT

(entget

(setq ENTNME

(ssname ENTS CNTR)

)

)

)

)

)

) LsufFIX

)

) OLD ENTDAT

)

)

(entmod ENTDAT)

(entupd ENTNME)

(setq CNTR (1+ CNTR))

(prompt ".")

);repeat

(princ)

)

 

ROUTINE 2

 

;THIS ROUTINE MAKES A LIST OF ALL THE (LAYER NAMES, COLOR AND LINETYPE)

;IN A SELECTION, PLUS RETURNS THE SELECTION SET IN THE FORM

;(((N C LT)(N C LT)...))(SELECTION SET))

;

;to retrieve the selection set use (cadr (ncltlist))

;

;

(defun ncltlist()

(if (not nmelist)(load "nmelist"))

(setq STUFF (nmelist)

NCLT nil

NLIST (car STUFF)

ss1 (cdr STUFF)

)

(foreach LNAME NLIST (progn

(setq LDAT (tblsearch "layer" LNAME)

LCOLOR (cdr (ASSOC 62 LDAT))

LLTYPE (cdr (ASSOC 6 LDAT))

NCLT (CONS (list LNAME LCOLOR LLTYPE) NCLT)

)

)

)

(setq output (cons NCLT ss1))

);defun

 

ROUTINE 3

 

;THIS ROUTINE MAKES A LIST OF ALL THE LAYER NAMES

;IN A SELECTION

(defun nmelist()

(setq cntr 0

NLIST '()

ss1 (ssget)

)

(repeat (sslength ss1)

(setq LYRNME (cdr (assoc 8 (entget (ssname ss1 cntr)))))

(if (not (member LYRNME NLIST))

(setq NLIST (cons LYRNME NLIST))

)

(setq CNTR (1+ CNTR))

);repeat

(setq output (list nlist ss1))

);defun

 

 

ROUTINE 4

 

;* USTR User interface string

;* If BIT=1 no null "" input allowed, 0 for note, BIT ignored if DEF present.

;* MSG is the prompt string, to which a default string is added a (nil

;* or "" for none), and a : is added. If SPFLAG T, spaces are allowed in

;* string.

;*

(defun ustr (bit msg def spflag / inp nval)

(if (and def (/= def ""))

(setq msg (strcat "\n" msg " : ")

inp (getstring msg spflag)

inp (if (= inp "") def inp)

);setq

(progn

(setq msg (strcat "\n" msg ": "))

(if (= bit 1)

(while (= "" (setq inp (getstring msg spflag))))

(setq inp (getstring msg spflag))

) );progn & if

);if

inp

);defun

;*

Link to comment
Share on other sites

Here is one to play with:

;;  CAB 03.09.07
;;  LayerRename.lsp
;;  Rename selected layers with prefix or suffix
(defun c:Lprefix()
 (LayerRename t)
)
(defun c:Lsuffix()
  (LayerRename nil)
)
;;  Use these to change the string
(defun c:ChgPrefix ()
 (while
   (progn
     (initget 1)
     (setq *prefix (getstring t "\nEnter the prefix: "))
     (= "" *prefix)
   )
   (princ)
 )
)(defun c:ChgSuffix ()
 (while
   (progn
     (initget 1)
     (setq *suffix (getstring t "\nEnter the suffix: "))
     (= "" *suffix)
   )
 )
  (princ)
)


(defun LayerRename (pre / obj lyr newlyr str getlyr)
 (defun GetLayer (Obj)
   (vla-get-name (vla-item (vla-get-layers *doc*) (vla-get-layer Obj)))
 )
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *doc* (setq *doc* (vla-get-activedocument *acad*)))
 (if Pre
   (if (or (null *prefix) (= *prefix "")) (c:ChgPrefix))
   (if (or (null *suffix) (= *suffix "")) (c:ChgSuffix))
 )
 (if Pre
   (setq str *prefix)
   (setq str *suffix)
 )
 (while (setq ent (entsel "\nSelect an object to rename the layer."))
   (setq obj (vlax-ename->vla-object (car ent)))
   (cond
     ((wcmatch (setq lyr (getlayer obj)) "*|*")
      (prompt "\n**  Can not rename a xref layer.")
     )
     ((wcmatch lyr (strcat "*" str "*")) ; potential problems here
      ;;  if the layer name inadvertenlt has the matching string
      (prompt "\n**  This layer is already renamed.")
     )
     (t
      (if Pre (setq newlyr (strcat str lyr)) (setq newlyr (strcat lyr str)))
      (if (vl-catch-all-error-p
            (vl-catch-all-apply
              'vla-put-name
              (list (vla-item (vla-get-layers *doc*) (vla-get-layer Obj))
                    newlyr)))
        (prompt (strcat "\n**  Layer " lyr " could not be renamed."))
        (prompt (strcat "\nLayer " lyr " has been renamed."))
      )
     )
   )
 )
 (princ)
)
(prompt (strcat "\nLayer Rename loaded, Enter LaRn to run."
               "\nEnter ChgSuffix to change the siffix."))
(princ)

Link to comment
Share on other sites

you are great mr CAB

I try to combine the 2 routin to have a choice to rename all layers or one by one by selecting object in one command but i failed i do like that

code

(defun c:chlrnm(/ *prefix)

(setq txtstle(getvar"textstyle"))

(initget 1 "Multiple Single")

(setq ser1(getkword"\n Multiple layer or Single layer(Single)"))

(if(not ser1)

(progn

(setq ser1 "Single")

)

)

(if(= ser1 "Multiple")

(progn

(vl-load-com)

(initget "Prefix Suffix _ P S")

(setq adoc (vla-get-activedocument (vlax-get-acad-object))

answer (getkword "\nUse string like [Prefix/Suffix] : ")

str (getstring "\nString to add : ")

) ;_ end of setq

(vla-startundomark adoc)

(if (not answer)

(setq answer "P")

) ;_ end of if

(vlax-for item (vla-get-layers adoc)

(vl-catch-all-apply

'vla-put-name

(list

item

(cond

((= answer "P")

(strcat str (vla-get-name item))

)

(t

(strcat (vla-get-name item) str)

)

) ;_ end of cond

) ;_ end of list

) ;_ end of VL-CATCH-ALL-APPLY

) ;_ end of vlax-for

(vla-endundomark adoc)

)

)

(if(= ser1 "Single")

(progn

 

;; Use these to change the string

(defun c:ChgPrefix ()

(while

(progn

(initget 1)

(setq *prefix (getstring t "\nEnter the prefix: "))

(= "" *prefix)

)

(princ)

)

)(defun c:ChgSuffix ()

(while

(progn

(initget 1)

(setq *suffix (getstring t "\nEnter the suffix: "))

(= "" *suffix)

)

)

(princ)

)

 

 

(defun LayerRename (pre / obj lyr newlyr str getlyr)

(defun GetLayer (Obj)

(vla-get-name (vla-item (vla-get-layers *doc*) (vla-get-layer Obj)))

)

(vl-load-com)

(or *acad* (setq *acad* (vlax-get-acad-object)))

(or *doc* (setq *doc* (vla-get-activedocument *acad*)))

(if Pre

(if (or (null *prefix) (= *prefix "")) (c:ChgPrefix))

(if (or (null *suffix) (= *suffix "")) (c:ChgSuffix))

)

(if Pre

(setq str *prefix)

(setq str *suffix)

)

(while

(setq ent (entsel "\nSelect an object to rename the layer."))

(setq obj (vlax-ename->vla-object (car ent)))

(cond

((wcmatch (setq lyr (getlayer obj)) "*|*")

(prompt "\n** Can not rename a xref layer.")

)

((wcmatch lyr (strcat "*" str "*")) ; potential problems here

;; if the layer name inadvertenlt has the matching string

(prompt "\n** This layer is already renamed.")

)

(t

(if Pre (setq newlyr (strcat str lyr)) (setq newlyr (strcat lyr str)))

(if (vl-catch-all-error-p

(vl-catch-all-apply

'vla-put-name

(list (vla-item (vla-get-layers *doc*) (vla-get-layer Obj))

newlyr)))

(prompt (strcat "\n** Layer " lyr " could not be renamed."))

(prompt (strcat "\nLayer " lyr " has been renamed."))

)

)

)

 

)

(princ)

)

)

)

)

;;;;;;;;;;;;

any help will be a ppreciated

Link to comment
Share on other sites

I would like to see what command I can use to add "Exist" to all the layers in a drawing.

 

I understand the basic lisp commands,

 

Thanks

 

Hi gman,

test this code

(defun table (s / d r)                     ; Michael Puckett
 (while
   (setq d (tblnext s (null d)))
   (setq r (cons (cdr (assoc 2 d)) r))
   )
 )

(defun c:test (/ add lst xlay)
 (setq lst (cdr (reverse (table "layer"))))
 (setq add "Exist")
 (foreach x lst
   (setq xlay (strcat x " - " add))
   (command "_rename" "layer" x xlay)
   )    ; foreach
 (princ)
 )      ; defun

Link to comment
Share on other sites

This works well but my goal is to select the layer and then add the suffix. This routine makes everthing with the suffix exist. Thanks for looking.

Link to comment
Share on other sites

you are great mr CAB

I try to combine the 2 routin to have a choice to rename all layers or one by one by selecting object in one command but i failed i do like that

any help will be a ppreciated

 

Glad you liked it, try this version. No support for Single mode though.

 

(defun c:chlrnm (/ SorP tmp str)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *doc* (setq *doc* (vla-get-activedocument *acad*)))

 (setq txtstle (getvar "textstyle"))
 ;|
 (initget "Multiple Single")
 (if (not (setq ser1
                 (getkword "\n Multiple or Single layer [Multiple/Single] <Single> "
                 )
          )
     )
   (setq ser1 "Single")
 )
 |;
 (initget "Prefix Suffix")
 (if
   (not (setq SorP (getkword "\nUse string like [Prefix/Suffix] <Prefix> : ")))
    (setq SorP "Prefix")
 )

 (or *prefix (setq *prefix "none"))
 (or *suffix (setq *suffix "none"))

 (if (= SorP "Prefix")
   (setq str *prefix)
   (setq str *suffix)
 )

 (if (/= (setq tmp (getstring t (strcat "\nString to add <" str "> : "))) "")
   (setq str tmp)
 )
 (vla-startundomark *doc*)
 (if (= SorP "Prefix")
   (setq *prefix str)
   (setq *suffix str)
 )
 (LayerRename (= SorP "Prefix"))
 (vla-endundomark *doc*)
 (princ)
)

Link to comment
Share on other sites

still have problem

it gives:; error: no function definition: LAYERRENAME

sorry CAB

close autocad and reopen it then check the routin

in this case we can see bugs

thanks

Link to comment
Share on other sites

  • 3 years later...

Dear CAB,

 

To the less learned in LISP and nonetheless interested user that has picked up on this valuable thread::cry:

 

Are there any changes that would be required in the code format or placement of the code, etc., when combining the two routines?

-OR-

Would this be a simple paste using the code from RENAME.LSP and inserting it at the bottom of the previous CHLRNM.LSP routine and using the RENAME.LSP routine name?

 

Clint

Link to comment
Share on other sites

  • 1 year later...

CAB, I set up the routine and it works well. It is important that it was possible to simultaneously change all the existing layers in the drawing. Better yet, would make the choice (one or all layers).

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

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