gman Posted August 17, 2006 Share Posted August 17, 2006 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 Quote Link to comment Share on other sites More sharing options...
CarlB Posted August 17, 2006 Share Posted August 17, 2006 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. Quote Link to comment Share on other sites More sharing options...
India Posted August 18, 2006 Share Posted August 18, 2006 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 Quote Link to comment Share on other sites More sharing options...
kpblc Posted August 21, 2006 Share Posted August 21, 2006 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 Quote Link to comment Share on other sites More sharing options...
royalchill Posted March 8, 2007 Share Posted March 8, 2007 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.. Quote Link to comment Share on other sites More sharing options...
motee-z Posted March 8, 2007 Share Posted March 8, 2007 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 Quote Link to comment Share on other sites More sharing options...
royalchill Posted March 8, 2007 Share Posted March 8, 2007 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 ;* Quote Link to comment Share on other sites More sharing options...
CAB Posted March 9, 2007 Share Posted March 9, 2007 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) Quote Link to comment Share on other sites More sharing options...
motee-z Posted March 11, 2007 Share Posted March 11, 2007 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 Quote Link to comment Share on other sites More sharing options...
Adesu Posted March 12, 2007 Share Posted March 12, 2007 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 Quote Link to comment Share on other sites More sharing options...
royalchill Posted March 12, 2007 Share Posted March 12, 2007 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. Quote Link to comment Share on other sites More sharing options...
CAB Posted March 12, 2007 Share Posted March 12, 2007 you are great mr CABI 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) ) Quote Link to comment Share on other sites More sharing options...
motee-z Posted March 12, 2007 Share Posted March 12, 2007 Hi CAB The routin not working it gives numberp nill please check Quote Link to comment Share on other sites More sharing options...
CAB Posted March 12, 2007 Share Posted March 12, 2007 OK, I fixed it. I think:) Quote Link to comment Share on other sites More sharing options...
motee-z Posted March 13, 2007 Share Posted March 13, 2007 still have problem it gives letter:; error: bad argument type: VLA-OBJECT nil thanks Quote Link to comment Share on other sites More sharing options...
CAB Posted March 13, 2007 Share Posted March 13, 2007 I think I got all the bugs this time. Quote Link to comment Share on other sites More sharing options...
motee-z Posted March 13, 2007 Share Posted March 13, 2007 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 Quote Link to comment Share on other sites More sharing options...
CAB Posted March 13, 2007 Share Posted March 13, 2007 Yes it uses the subroutine found in post #8 of this thread. You should save them to one LISP file so they are loaded togather. Quote Link to comment Share on other sites More sharing options...
chillpill Posted July 19, 2010 Share Posted July 19, 2010 Dear CAB, To the less learned in LISP and nonetheless interested user that has picked up on this valuable thread: 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 Quote Link to comment Share on other sites More sharing options...
teknomatika Posted October 10, 2011 Share Posted October 10, 2011 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). Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.