Jump to content

Autolisp_ Change Layer Names


QuinnL

Recommended Posts

Still learning Autolisp, so sorry if it is any easy solution I overlooked. 

 

For approval, our city requires we send them our CAD files (civil 3d). With the new 2023 manual, we need to change our layers names to match the ones they gave us. Below is the code I currently have which uses the command "rename". It seems to mostly work however, I have two problems. 

 

1. If the layer does not existing in the dwg, the command gives me "; error, function cancelled'. (Maybe an if statement that says to only run the command if the layer can be found in the dwg??)

 

2. The command "rename" seems to also not like it when the layer name you are switching to already existing in the dwg. I believe that gives me an error too. 

 

Thanks for the help.  

UDCF Autolisp_CAD tutor.JPG

Link to comment
Share on other sites

The option from Lee Mac here is a good start

 

 

Make a list of the layers and loop through this

Edited by Steven P
  • Like 2
Link to comment
Share on other sites

Layer rename supports wildcards so may be able to do a "sl-*" "xx-*"

 

You can check if a "sl-*" layer exists using (setq ss "X" '((8 . "sl-*"))) if ss is not nil proceed.

 

You can check if layer exists by (tblsearch "LAYER" "sl-pl")

 

I would set up a file with all the layer names as a CSV file then read it you can make it in excel and save as csv. This way can do 100's "sl-pl,xx-lots-ln" 

 

So I have not posted anything as are you happy with file idea ?

 

Did the same task but we just added EX- to certain layers to identify existing features. Ex-lip v's Lip

 

 

 

Edited by BIGAL
  • Like 1
Link to comment
Share on other sites

Look into the LAYTRANS command too.

image.png.125fc2858cfcb37b7f0e5e8f64976496.png

 

If you want to stick with the lisp it could be refactored like so to check if the source layer exists.

(foreach layer '(("SL-PL" "XX-LOTS-LN") ("SL-BNDRY" "XX-SUB-BDY"))
  (if (tblsearch "LAYER" (car layer))
    (command "_.RENAME" "_LAYER" (car layer) (cadr layer))
  )
)

 

  • Like 2
Link to comment
Share on other sites

Not In BricsCAD, but try it out in AutoCAD.

 

: (tblsearch "layer" "Te*")
nil
: (tblsearch "layer" "Test")
((0 . "LAYER") (2 . "Test") (70 . 0) (62 . 2) (6 . "Continuous"))

 

 

  • Like 1
Link to comment
Share on other sites

Here are my three functions for layers. Rename, Merge and create

 

;;----------------------------------------------------------------------------;;
;; Rename Layers (RLayer '(oldlayers1, oldlayers2) '(newlayer1, newlayer2))
(defun RLayer (#OldLayers #NewLayers / #Layers)
  (vl-load-com)
  (setq #Layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  (mapcar
    '(lambda (o n)
             (and (tblsearch "layer" o) (not (tblsearch "layer" n))
                  (vl-cmdf "_-Rename" "LA" o n)
             ) ;_ and
     ) ;_ lambda
    #OldLayers
    #NewLayers
  ) ;_ mapcar
)

;;----------------------------------------------------------------------------;;
;; Merge Layers (MLayer '(oldlayers1, oldlayers2) '(newlayer1, newlayer2))
(defun MLayer (#OldLayers #NewLayers / #Layers)
  (vl-load-com)
  (setq #Layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  (mapcar
    '(lambda (o n)
             (and (tblsearch "Layer" o)
                  (or (tblsearch "layer" n) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 n) '(70 . 0) '(62 . 3))))
               (progn
                 ;;BricsCAD has a merge layer but its not a typed command autocad code could clean up this one funtion
                 (setq SS (ssget "X" (list (cons 8 o))))
                 (vl-cmdf "_Chprop" SS "" "LA" n "")
                 (vl-cmdf "_Purge" "LA" o "N")
               )
             ) ;_ and
     ) ;_ lambda
    #OldLayers
    #NewLayers
  ) ;_ mapcar
)
;;----------------------------------------------------------------------------;;
;; Create New Layers (NLayer '(newlayer1, newlayer2 ....))
(defun NLayer (#NewLayers / lay)
  (foreach lay #NewLayers
    (if (not (tblsearch "Layer" lay))
      (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 lay) '(70 . 0) '(62 . 3)))
    )
  )
)

 

So I would have something like this

(defun C:updatelayers ()
  (RLayer '("lay1" "lay2" "lay3") '("Newlay1" "Newlay2" "Newlay3")) ;Rename old layer first if new layer isn't existing
  (MLayer '("lay1" "lay2" "lay3") '("Newlay1" "Newlay2" "Newlay3")) ;merge old layer to new layer if both layers exist 
  (Nlayer '("Newlay1" "Newlay2" "Newlay3")) ;create new layer if not existing already
)

 

Link to comment
Share on other sites

Just quickly searches through table listing and returns all that is found... if you put a * in the search term as a wild card too.... 

 

(defun c:testthis( / MyLayersList acount result )
  (defun Table (s / d r)
    (while (setq d (tblnext s (null d)))
      (setq r (cons (cdr (assoc 2 d)) r))
    )
  )
  (setq result (list)) ; make a blank list
  (setq MyLayersList (Table "layer") ) ; get list of all layers
(setq Mystring (getstring "\nEnter Seach term" T))
  (setq acount 0)
  (while ( < acount (length MyLayersList))
    (if (= (wcmatch (nth acount MyLayersList) Mystring) nil)
      (princ "\n not Matched")
      (setq result (append result (list (nth acount MyLayersList)) ))
    ) ; end if
    (setq acount (+ acount 1))
  ) ; end while
  result
)

 

Might need to do a loop from the result to rename the layers? 

 

 

 

 

... and because dinner is still cooking, the same thing with a foreach loop (slightly shorter code)

 

(defun c:testthis( / MyLayersList result )
  (defun Table (s / d r)
    (while (setq d (tblnext s (null d)))
      (setq r (cons (cdr (assoc 2 d)) r))
    )
  )
  (setq result (list)) ; make a blank list
  (setq MyLayersList (Table "layer") ) ; get list of all layers

(setq Mystring (getstring "\nEnter Seach term" T))

  (foreach x MyLayersList
    (if (= (wcmatch x Mystring) nil)
      (princ "\n not Matched")
      (setq result (append result (list x) ))
    ) ; end if
  ) ; for each
  result
)

 

Edited by Steven P
  • Like 2
Link to comment
Share on other sites

I like this StephenP... I've had a similar issue but slightly different with layer naming issues, this will help a lot.


Also... Just to make sure i'm reading this code correctly (still new to this coding game)
Am I right, that this could be modified to search the "Blocks" table? ,
and, if i entered Chamfer* (for example) into the search term
i could then, after another tweak, using the foreach, have it insert all blocks starting with chamfer (eg chamfer1204, chamfer 2306 etc)

 

  • Like 1
Link to comment
Share on other sites

Try it and see...

 

 

 

 

(seriously... it is the best way to learn! and is all I would be doing anyway)

Edited by Steven P
  • Like 1
  • Agree 1
Link to comment
Share on other sites

Yeah, I will do,

i'm just finishing up for the evening but i'll try to adapt it over the weekend

 

edit:
I got this to work for my needs


Changed

 (setq MyLayersList (Table "layer") ) ; get list of all layers


To

 setq MyBlocksList (Table "Block") ) ; get list of all Blocks

 

And

           (setq Mystring (getstring "\nEnter Seach term" T))

 

To

              (setq Mystring "Chamfer*") ; at tthe moment, this is all i need, so rather than keep typing it in..

 

And then adding  

(foreach x result
     (COMMAND ".-INSERT" x "E" "Y" "S" "1" "R" "0" "0,0")
    )

 

I agree, it is the best way to learn. I'm getting comfortable now being able to edit to suit my needs. 
I do however struggle to think of the best approach when creating my own from scratch.
They tend to start off very large and cumbersome, and as I learn or see how someone else has tackled a similar issue, I go back and make them more efficient.
Thanks again guys for the help (sorry Quinnl, for joining in on this, i hope you get what you need... these guys are awesome)

Edited by Sharper
Added results of a weekends coding
  • Like 1
Link to comment
Share on other sites

My $0.05, you will need to change where the csv file is located and its name, note the dbl \\ in file name. You can use GETFILE if you want to pick the file.

 

; thanks to Lee-mac for this defun
; 44 is comma 32 is space

(defun csv->lst ( str / pos )
(if (setq pos (vl-string-position 44 str))
    (cons (substr str 1 pos) (csv->lst (substr str (+ pos 2))))
    (list str)
    )
)

(defun c:wow ( / fo nline nstr oldlay newlay)
(setq fo (open (setq fname "D:\\acadtemp\\quinn-layer.csv") "R"))
(while (setq NLINE (read-line fo))
 (setq nstr (csv->lst nline))
 (setq oldlay (car nstr) newlay (cadr nstr))
 (if (tblsearch "layer" oldlay)
  (command "rename" "layer" oldlay newlay)
  (princ "\nNo layer")
 )
)
(close fo)
(princ)
)
(c:wow)

CSV file

sl-pl,xx-lots-ln
sl-bndy,xx-sub-bdy
sl-esmt,xx-esmt
sc-bldg,xx-building-ftprnt

Ps not tested as need a test dwg.

Edited by BIGAL
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...