Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

LISP to Remove Bind Prefixes and Merge Resulting Layers

Status
Not open for further replies.

CastleFurniture

Technical User
Sep 8, 2010
1
US
I am looking for a LISP file that will remove the X-Ref Prefixes from layers bound to a file then merge duplicate layers to the original layer already included in the file. I found this "Remove Bind Prefixes" lisp in an autodesk forum. It seems, no matter how much searching I do, I can't find an automated solution to the merging the results. Obviously there is laymrg, but it takes way too long to merge 40 or 50 layers one-at-a-time. Needless to say, I am not an expert at lisp but I, like a whole bunch of other folks on these forums, am trying to learn. Any help would be oh-so greatly appreciated.

Thanks

Remove Bind Prefixes:

(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)
)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top