Remove $0$ and everything before from Layer names

[architurk]

Hi there Irneb,

This "layerclean" lisp seems to work %100 on layers, that it is really great; but it doesn't seem to effect on block names? Would it be possible to convert this into block renaming as well? But maybe renaming/merging two blocks the same, might cause some critical problems, indifferent from layer renaming? Maybe lisp might interact to ask whether or not to merge in case of conflict?

Thx in advance and keep good work coming.

[dmeza]

Can someone please post the completed lisp? I'm way too rusty to complete this, and I sooo need this right now.

[dmeza]

Dude! This is awesome! I just used the SETBYLAYER command first to take care of "improper" blocks and it works fine. Thanks!

[Shashikant]

Hi everyone,

Does someone know how to write a lisp or know where I can find the code, that will remove $0$ and everything before that from the layer name in the layer manager.

From this - 532-IMP-BASE$0$area
to this - area

We are binding all the Civil, Architecture, & our base file to map a key map for the project.

Thanks,

Kyle C.

Dear Kyle
I have a modified lisp routine to rename not only layers but blocks, styles, linetypes etc. This routine will rename nested names also e.f. 501Site$0$xsite$0$XR$0$PLAN to PLAN
Just save the file and load and run command rnm

;; Routine to rename layers, block etc with binded $0$ names By Shashikant 27 Nov 2018

(defun c:rnm()
(a:rnm "LAYER")
(a:rnm "BLOCK")
(a:rnm "STYLE")
(a:rnm "LTYPE")
(a:rnm "DIMSTYLE")
)

(defun a:rnm (ob / LYRDXF NEWLAYNAME NEWLAYNAME-TEMP NUM OLDLAYNAME tlay)
 (while (setq LYRDXF (tblnext ob (not LYRDXF)))
  (if (wcmatch (setq OLDLAYNAME (cdr (assoc 2 LYRDXF))) "*$0$*")
   (progn
    (setq tlay OLDLAYNAME)
    (while (vl-string-search "$0$" tlay)
           (setq NUM (+ (vl-string-search "$0$" tlay) 4)
                        NEWLAYNAME (substr tlay NUM)
           )
           (setq tlay NEWLAYNAME)
    )
           
    (if (= (tblsearch ob NEWLAYNAME) nil)
     (command ".rename" ob OLDLAYNAME NEWLAYNAME)
     (progn
      (setq CNT 1)
      (while (tblsearch ob (setq NEWLAYNAME-TEMP (strcat NEWLAYNAME "-" (itoa CNT))))
       (setq CNT (1+ CNT))
      )
      (command ".rename" ob OLDLAYNAME NEWLAYNAME-TEMP)
     )
    )
   )
 
)
 )
 (princ)
)

This is a very compact routine which will help
Shashikant

[Matthias.Mangold784199]

Dear Kyle
I have a modified lisp routine to rename not only layers but blocks, styles, linetypes etc. This routine will rename nested names also e.f. 501Site$0$xsite$0$XR$0$PLAN to PLAN
Just save the file and load and run command rnm

;; Routine to rename layers, block etc with binded $0$ names By Shashikant 27 Nov 2018

(defun c:rnm()
(a:rnm "LAYER")
(a:rnm "BLOCK")
(a:rnm "STYLE")
(a:rnm "LTYPE")
(a:rnm "DIMSTYLE")
)

(defun a:rnm (ob / LYRDXF NEWLAYNAME NEWLAYNAME-TEMP NUM OLDLAYNAME tlay)
 (while (setq LYRDXF (tblnext ob (not LYRDXF)))
  (if (wcmatch (setq OLDLAYNAME (cdr (assoc 2 LYRDXF))) "*$0$*")
   (progn
    (setq tlay OLDLAYNAME)
    (while (vl-string-search "$0$" tlay)
           (setq NUM (+ (vl-string-search "$0$" tlay) 4)
                        NEWLAYNAME (substr tlay NUM)
           )
           (setq tlay NEWLAYNAME)
    )
           
    (if (= (tblsearch ob NEWLAYNAME) nil)
     (command ".rename" ob OLDLAYNAME NEWLAYNAME)
     (progn
      (setq CNT 1)
      (while (tblsearch ob (setq NEWLAYNAME-TEMP (strcat NEWLAYNAME "-" (itoa CNT))))
       (setq CNT (1+ CNT))
      )
      (command ".rename" ob OLDLAYNAME NEWLAYNAME-TEMP)
     )
    )
   )
 
)
 )
 (princ)
)

This is a very compact routine which will help
Shashikant

This Tool is awesome!! Thank you!
Is it possible to avoid the counter and merge all similar objects?

[aaronic_abacus]

You can add replace or remove prefixes with this

(DEFUN C:RLP ()
 (PROMPT "\n*REPLACE LAYER PREFIX* ")
 (SETQ LTSRL 1)
 (SETQ LPRE (GETSTRING "\nEnter existing layer prefix<none>: "))
 (SETQ NLPRE (GETSTRING "\nEnter new layer prefix<none>: "))
 (SETQ LP 1)
 (WHILE LP
  (SETQ LTS (TBLNEXT "LAYER" LTSRL))
  (SETQ LTSRL NIL)
  (IF (/= LTS NIL)
   (PROGN
    (SETQ LTST (CDR (ASSOC 2 LTS)))
    (SETQ LTSTL (STRLEN LTST))
    (SETQ CP 1)
    (SETQ LP2 1)
    (WHILE LP2
     (SETQ LS (SUBSTR LTST 1 CP))
     (SETQ CP (+ CP 1))
     (IF (AND (= LPRE "") (/= LTST "0"))
      (PROGN
       (SETQ NLN (STRCAT NLPRE LTST))
       (COMMAND "RENAME" "LA" LTST NLN)
       (SETQ LP2 NIL)
     ));END PROGN/IF LS
     (IF (AND (= LS LPRE) (/= LTST "0"))
      (PROGN
       (SETQ NLN (STRCAT NLPRE (SUBSTR LTST CP)))
       (COMMAND "RENAME" "LA" LTST NLN)
       (SETQ LP2 NIL)
     ));END PROGN/IF LS
     (IF (> CP LTSTL) (SETQ LP2 NIL))
    );END LP2
  ));END PROGN/IF LTS
  (IF (= LTS NIL) (SETQ LP NIL))
 );END LP
 (PRINC)
);END RLP