Cleaning up $0$ Layers in Binded Drawings

[harilalmn]

Hi All,

I have so many drawings in which the xrefs were 'bind'ed instead of 'insert'ing.

Seeking a solution I got a Lisp routine from net (Thanks to the person posted it. But I don't remember his name or the wesite I got it from), which is as given below. The problem is that $0$ layers are not getting renamed because I have another layer in the same name. Suppose;

I have a layer, Ground Floor Plan$0$A-ANNO-DIMS which has to be renamed to A-ANNO-DIMS

Since the drawing has a layer A-ANNO-DIMS, it doesn't allow the lisp to rename it. I have the logic now but I am a zero in lisp.

 

It has to check if the layer exists before renaming.

If existing it should merge down the $0$ layer to the standard one. (This part is missing in the lisp routine)

 

Can anyone please change the code to do so? It would be a great help...

Here is the code;

 

 

 

(defun c:RBP(/ ActDoc Name NewName)

; RemoveBindPrefixes

; Renames layers, blocks, dimension styles, text styles, user coordinate systems, and views

; by taking out the bind as bind prefix

; Example Drawing1$0$Layer1 -> Layer1

 

(vl-load-com)

(defun RemoveBindPrefix (String / Pos LastPos)

 

(if (setq Pos (vl-string-search "$" String))

(progn

(setq LastPos Pos)

(while (setq Pos (vl-string-search "$" String (1+ Pos)))

(setq LastPos Pos)

)

(substr String (+ 2 LastPos))

)

String

)

)

;---------------------------------------------------------

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))

(vlax-for Obj (vla-get-Layers ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Layer: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-Blocks ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Block: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-TextStyles ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Text style: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-Views ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n View: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-UserCoordinateSystems ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n UCS: " Name " was not renamed."))

)

)

)

(vlax-for Obj (vla-get-DimStyles ActDoc)

(setq Name (vla-get-Name Obj))

(if (/= (setq NewName (RemoveBindPrefix Name)) Name)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list Obj NewName)))

(prompt (strcat "\n Dimension style: " Name " was not renamed."))

)

)

)

(princ)

)

[ReMark]

Perhaps you are referring to the lisp routine written by CAB2k that was included as part of post #10 in this thread at the AUGI website.

 

http://forums.augi.com/showthread.php?t=31759

[harilalmn]

Yeah I have gone through that.

But that was not what I exactly wanted....!!

That routine first adds prefix to all XRef Layers like X1, X2, X3 etc....

It does not merge down the layers.

In the code I posted here, it does the job perfectly, but I just wanted it to merge down the Layers, Text Styles, Dimension Styles Etc... to the standard ones.

Could someone please edit the code to achieve it?

[alanjt]

This may offer some insight.

http://www.cadtutor.net/forum/showthread.php?43156-Too-many-layers!!!-Need-to-merge-them!&highlight=laymrg