copy/rename layer

May 14, 2013

Here's one I use on a regular basis:

(defun c:Clone (/ ent layer name)
 ;; Clone selected object's layer
 ;; Required subroutine: AT:GetString
 ;; Alan J. Thompson, 02.09.11
 (setvar 'ERRNO 0)
 (if (while (and (not ent) (/= 52 (getvar 'ERRNO)))
       (initget 0 "Current")
       (setq ent (entsel "\nSelect object on layer to clone [Current]: "))
     )
   (cond ((not (setq name (AT:GetString
                            "Specity clone layer name:"
                            (setq layer (if (eq (type ent) 'STR)
                                          (getvar 'CLAYER)
                                          (cdr (assoc 8 (entget (car ent))))
                                        )
                            )
                          )
               )
          )
         )
         ((not (snvalid name)) (alert "Invalid name!"))
         ((apply (function eq) (mapcar (function strcase) (list name layer)))
          (alert "Clone layer cannot have same name as base layer!")
         )
         ((tblsearch "LAYER" name) (alert "Layer already exist!"))
         ((entmake (append
                     (list '(0 . "LAYER")
                           '(100 . "AcDbSymbolTableRecord")
                           '(100 . "AcDbLayerTableRecord")
                           (cons 2 name)
                     )
                     (vl-remove-if-not
                       (function (lambda (x) (vl-position (car x) '(6 62 70 270 370))))
                       (entget (tblobjname "LAYER" layer))
                     )
                   )
          )
          (alert (strcat "Layer \""
                         layer
                         "\" has been cloned to create layer: \""
                         (setvar 'CLAYER name)
                         "\""
                 )
          )
         )
   )
 )
 (princ)
)

(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";"
              "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;"
              "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {"
              "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}"
              "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {"
              "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)

May 14, 2013

Hi alanjt,

thank you, it works greatly! I just noticed you are the author of "Block Rename". I know it's kind of too much to ask you, but could you be so kind and please modify it to something like "layer rename"? I've already spent hours trying to modify it on my own but without any success...

Edited May 15, 2013 by ajax30

May 14, 2013

This reminds me that I need to finish my 'Right Click Rename' .NET plug-in, that I started back in the 2014 Betas... It stemmed from a 'Right Click Rename Layer' plug-in I wrote for a user there.

Basically, the former allows for one to select a single entity, and Rename all contextual properties of that Entity Type, disabling those which cannot be Renamed (i.e., "0" Layer, etc.), while automatically feeding the existing Property values into the -RENAME Command for you.

It (my plug-in) works well for AutoCAD 2010-2014, but has some issues for Civil 3D, as nearly all AECC* Objects are derived from BlockReference Type, so I need to make some time to revise the source-code to check for ObjectName instead of Type-casting as BlockReference, Entity, Dimension, Multileader, Table, etc.... I also wanted to build in the support for Right Click Renaming of Section Views, etc. which are not presently accounted for... When done, it was my intention to submit to Autodesk Exchange along with some of my other plug-ins.

[Edit] - I also was hoping to make the time necessary to add a Civil 3D specific adaptation, that would expand the RENAME Command to support Civil 3D's myriad Styles as well (from the plug-in's Context menu)

May 17, 2013

Is somebody eager to make simple lisp for renaming layers that will help millions of frustrated cad monkeys?

May 17, 2013

cad monkeys?

......

May 18, 2013

Is somebody eager to make simple lisp for renaming layers that will help millions of frustrated cad monkeys?

You may need to describe the issue in more details .

May 18, 2013

Is somebody eager to make simple lisp for renaming layers that will help millions of frustrated cad monkeys?

RENAME command?

May 18, 2013

Is somebody eager to make simple lisp for renaming layers that will help millions of frustrated cad monkeys?

i use this to rename a single Layer without opening the Layer Manager

;Tip1742:  RENLYR.LSP       Rename layer          (c)2001, Jeff Foster

;OBJECTIVE***
;The purpose of this routine is to allow the user to pick an entity
;on a layer that needs to be renamed.  The layer name comes up in an
;edit box, allowing for the revision of the name.
;
;TO RUN***
;At the command line, type (load "c:/lispdir/RENLYR")
;where c:/ is the drive where RENLYR.lsp is contained
;where lispdir/ is the directory where RENLYR.lsp is contained

(Defun C:RENLYR (/ e e-inf e-lyr txtlist sstxt sse see-inf sse-txt)
 (prompt "\n")
 (princ)
 (while (= (setq e (car (entsel "\rSelect entity of layer to rename: "))) nil))
 (setq
   e-inf (entget e)
   e-lyr (cdr (assoc 8 e-inf))
 )
 (if (/= e-lyr "0")
   (progn
     (setq txtlist (list (cons 0 "TEXT") (cons 1 e-lyr) (cons 10 (getvar "viewctr")) (cons 40 0.000001) (cons 50 0.0)))
     (entmake txtlist)
     (setq sstxt (entlast))
     (command "ddedit" sstxt "")
     (setq
       sse (entlast)
       sse-inf (entget sse)
       sse-txt (cdr (assoc 1 sse-inf))
     )
     (if (and (/= (strcase sse-txt) (strcase e-lyr)) (/= sse-txt "") (= (wcmatch sse-txt "* *") nil))
       (command "rename" "layer" e-lyr sse-txt)
       (cond
         ((= (strcase sse-txt) (strcase e-lyr))
             (prompt "\nLayer name has not been modified, name is identical")
             (princ)
          )
         ((= sse-txt "")
             (prompt "\nLayer name has not been modified, nil length string")
             (princ)
          )
         ((/= (wcmatch sse-txt "* *") nil)
             (prompt "\nLayer name has not been modified, name has space")
             (princ)
          )
        )
     )
     (command "erase" sstxt "")
   )
   (progn
     (if (= e-lyr "0")
       (progn
         (prompt "\nCannot rename layer 0")
         (princ)
       )
     )
   )
 )
 (princ)
)

May 18, 2013

i use this to rename a single Layer without opening the Layer Manager

Amazing! thank you very much! this is exactly what I've been looking for so long time!

May 18, 2013

RENAME command?

RENAME is handy for batch renaming but renaming only few layers in drawing with hundreds of layers (with weird names) was driving me crazy. btw it's pity LAYWALK doesn't have option to rename layers.

Anyway thanks for suggestion!

May 20, 2013

Amazing! thank you very much! this is exactly what I've been looking for so long time!

You're welcome

May 21, 2013

This reminds me that I need to finish my 'Right Click Rename' .NET plug-in, that I started back in the 2014 Betas... It stemmed from a 'Right Click Rename Layer' plug-in I wrote for a user there.

Basically, the former allows for one to select a single entity, and Rename all contextual properties of that Entity Type, disabling those which cannot be Renamed (i.e., "0" Layer, etc.), while automatically feeding the existing Property values into the -RENAME Command for you.

It (my plug-in) works well for AutoCAD 2010-2014, but has some issues for Civil 3D, as nearly all AECC* Objects are derived from BlockReference Type, so I need to make some time to revise the source-code to check for ObjectName instead of Type-casting as BlockReference, Entity, Dimension, Multileader, Table, etc.... I also wanted to build in the support for Right Click Renaming of Section Views, etc. which are not presently accounted for... When done, it was my intention to submit to Autodesk Exchange along with some of my other plug-ins.

[Edit] - I also was hoping to make the time necessary to add a Civil 3D specific adaptation, that would expand the RENAME Command to support Civil 3D's myriad Styles as well (from the plug-in's Context menu)

Not that Rename is all that tough, but that would be very nice to have Blackbox. I can't tolerate all these blocks in old drawings with out descriptive names.

May 21, 2013

Not that Rename is all that tough, but that would be very nice to have Blackbox. I can't tolerate all these blocks in old drawings with out descriptive names.

Cheers, SLW ... I hope to have it (my plug-in) available at Autodesk Exchange soon. *crosses fingers*

May 21, 2013

(defun c:RenL (/ ent old new)
 ;; Rename Layer of Selected Object
 ;; Required Subroutines: AT:Getstring
 ;; Alan J. Thompson, 11.30.09 / 05.21.13
 (while (progn (setvar 'ERRNO 0)
               (setq ent (car (entsel "\nSelect object on layer to change name: ")))
               (if (eq (getvar 'ERRNO) 7)
                 (princ "\nMissed, try again.")
               )
        )
 )

 (cond
   ((not ent))
   ((member
      (setq new (AT:Getstring "Specify new layer name:" (setq old (cdr (assoc 8 (entget ent))))))
      (list "" nil old)
    )
   )
   ((tblsearch "LAYER" new) (alert (strcat "Layer: \"" new "\" already exists!")))
   ((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!")))
   ((vl-catch-all-error-p
      (vl-catch-all-apply
        'vla-put-name
        (list (vlax-ename->vla-object (tblobjname "LAYER" old)) new)
      )
    )
    (alert (strcat "Layer: " old " could not be renamed to: " new))
   )
   ((alert (strcat "Layer: " old " renamed to: " new)))
 )

 (princ)
)



(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {"                      "key = \"Title\";"
              "label = \"\";"        "initial_focus = \"Edit\";"
              "spacer;"              ": row {"              ": column {"
              "alignment = centered;"                       "fixed_width = true;"
              ": text {"             "label = \"\";"        "}"
              "}"                    ": edit_box {"         "key = \"Edit\";"
              "allow_accept = true;" "edit_width = 40;"     "fixed_width = true;"
              "}"                    "}"                    "spacer;"
              ": row {"              "fixed_width = true;"  "alignment = centered;"
              ": ok_button {"        "width = 11;"          "}"
              ": cancel_button {"    "width = 11;"          "}"
              "}"                    "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)

May 21, 2013

(defun c:RenL (/ ent old new)
 ;; Rename Layer of Selected Object
 ;; Required Subroutines: AT:Getstring
 ;; Alan J. Thompson, 11.30.09 / 05.21.13
)

:winner:It works like a charm! thank you so much!

May 21, 2013

Nice one, Alan.

To offer a 'lite' version:

[color=GREEN];; Rename Layer  -  Lee Mac[/color]

([color=BLUE]defun[/color] c:rl ( [color=BLUE]/[/color] ent lay )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect object on layer to rename: "[/color])))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]and[/color] ent
                       ([color=BLUE]setq[/color] lay ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ent)))
                             ent ([color=BLUE]entget[/color] ([color=BLUE]tblobjname[/color] [color=MAROON]"layer"[/color] lay))
                             lay (LM:editbox lay)
                       )
                   )
                   ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 2 lay) ([color=BLUE]assoc[/color] 2 ent) ent))
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Edit Box  -  Lee Mac[/color]
[color=GREEN];; Displays a DCL edit box to obtain a string from the user[/color]

([color=BLUE]defun[/color] LM:editbox ( str [color=BLUE]/[/color] dcl )
   ([color=BLUE]and[/color]
       ([color=BLUE]<[/color] 0 ([color=BLUE]setq[/color] dcl ([color=BLUE]load_dialog[/color] [color=MAROON]"ACAD"[/color])))
       ([color=BLUE]new_dialog[/color] [color=MAROON]"acad_txtedit"[/color] dcl)
       ([color=BLUE]set_tile[/color] [color=MAROON]"text_edit"[/color] str)
       ([color=BLUE]action_tile[/color] [color=MAROON]"text_edit"[/color] [color=MAROON]"(setq str $value)"[/color])
       ([color=BLUE]zerop[/color] ([color=BLUE]start_dialog[/color]))
       ([color=BLUE]setq[/color] str [color=BLUE]nil[/color])
   )
   ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 dcl) ([color=BLUE]unload_dialog[/color] dcl))
   str
)
([color=BLUE]princ[/color])

May 21, 2013

@Lee: You know, in retrospect, I don't know why I fooled with changing it to VL just to change the name. Brain wasn't screwed on all the way that day and all I did as a revision was clean up the code.

I decided to update mine to exclude the unneeded use of VL and to give the option to edit the current layer - something I've been meaning to add any way.

(defun c:RenL (/ ent old new lay)
 ;; Rename Layer of Selected Object or current layer
 ;; Required Subroutines: AT:Getstring
 ;; Alan J. Thompson, 11.30.09 / 05.21.13
 (while (progn (setvar 'ERRNO 0)
               (initget 0 "Current")
               (setq ent (entsel "\nSelect object on layer to change name [Current]: "))
               (if (eq (getvar 'ERRNO) 7)
                 (princ "\nMissed, try again.")
               )
        )
 )

 (cond
   ((not ent))
   ((member
      (setq new
             (AT:Getstring
               "Specify new layer name:"
               (if (eq (type ent) 'STR)
                 (cdr (assoc 2
                             (setq lay (entget
                                         (tblobjname "LAYER" (setq old (getvar 'CLAYER)))
                                       )
                             )
                      )
                 )
                 (cdr
                   (assoc 2
                          (setq lay (entget (tblobjname
                                              "LAYER"
                                              (setq old (cdr (assoc 8 (entget (car ent)))))
                                            )
                                    )
                          )
                   )
                 )
               )
             )
      )
      (list "" nil old)
    )
   )
   ((tblsearch "LAYER" new) (alert (strcat "Layer: \"" new "\" already exists!")))
   ((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!")))
   ((entmod (subst (cons 2 new) (assoc 2 lay) lay))
    (alert (strcat "Layer: " old " renamed to: " new))
   )
   ((alert (strcat "Layer: " old " could not be renamed to: " new)))
 )

 (princ)
)



(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {"                      "key = \"Title\";"
              "label = \"\";"        "initial_focus = \"Edit\";"
              "spacer;"              ": row {"              ": column {"
              "alignment = centered;"                       "fixed_width = true;"
              ": text {"             "label = \"\";"        "}"
              "}"                    ": edit_box {"         "key = \"Edit\";"
              "allow_accept = true;" "edit_width = 40;"     "fixed_width = true;"
              "}"                    "}"                    "spacer;"
              ": row {"              "fixed_width = true;"  "alignment = centered;"
              ": ok_button {"        "width = 11;"          "}"
              ": cancel_button {"    "width = 11;"          "}"
              "}"                    "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)

May 21, 2013

:winner:It works like a charm! thank you so much!

Completely missed your comment; apologies. I'm glad you like it. see the revised one just above.

May 22, 2013

Completely missed your comment; apologies. I'm glad you like it. see the revised one just above.

well i noticed it didnt work so well but updated version works nicely. lee mac's version works also...thank you!

May 22, 2013

well i noticed it didnt work so well but updated version works nicely. lee mac's version works also...thank you!

There shouldn't have been anything wrong with the original version I posted. I only changed my method to avoid the use of VLISP, but both should work. What problem did you have with the first?

Sign In

copy/rename layer

Recommended Posts

alanjt

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

alanjt

alanjt

alanjt

Posted Images

ajax30

BlackBox

ajax30

Tharwat

Tharwat

Lee Mac

nod684

ajax30

ajax30

nod684

SLW210

BlackBox

alanjt

ajax30

Lee Mac

alanjt

alanjt

ajax30

alanjt

Join the conversation

alanjt

alanjt

alanjt

Tutorials

Forums

Activity