[编程交流] 合并Dimstyle和文字样式af

(defun c:RBP(/ ActDoc Name NewName)
(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
)
)
(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-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)
)

(defun c:RBP(/ ActDoc Name NewName)
; RemoveBindPrefixes
; Renames layers, blocks, dimension styles, text styles, user coordinate systems, and views
; Merging layers with same name
; Ex: 422-G100-DF$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)))
;-----------------
;Merging layers with same name after removing Prefix
(command "-LAYMRG" "_Name" name "" "_Name" NewName "_Yes")
;-------------------
(prompt (strcat "\n Layer: " Name " was merged in Layer " NewName))
)
)
)
(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)))
;MERGEDIM
(prompt (strcat "\n Dimension style: " Name " was not renamed."))
)
)
)
(princ)
)