删除绑定参照的图层名字前缀和线型名字前缀

hongxibao

麻烦大侠帮个忙！写个lsp
绑定参照后，把带进的图层名字和线型名字$0$之前前缀全部删掉（图纸说不定被二次参照，名字带有两个或三个$0$）

删除前缀时，如果有名字重合，则可以合并名字，如果不能合并，就在名字后面加个数字，比如1（加数字后，如果还有重合，继续循环运行加数字1，直到不重合）

KO你

快捷键  d+  批量图层名称加前缀
全部图层加前缀<除0,Defpoints>
(defun c:d+ ( / YY_QIANZ *doc* LAY LAYERS OLDMING)
(vl-load-com)
(setq YY_QIANZ (getstring "\n输入图层要加的前缀:"))
(if YY_QIANZ
(progn
(setq *doc* (vla-get-activedocument (vlax-get-acad-object))
layers (vla-get-layers *doc*))
(vlax-for lay layers (setq OLDMING (vla-get-name lay))
(if (not (member OLDMING '("0" "Defpoints")))
(vla-put-Name lay (strcat YY_QIANZ OLDMING)))))))

快捷键  d-  批量图层名称去前缀
(defun c:d- ()
(if (setq qz (getstring "\n输入图层要删除的前缀: "))
(vlax-for la (vla-get-layers(vla-get-activedocument (vlax-get-acad-object)))
(setq tx (vla-get-name la))
(if (and (not (member tx '("0" "Defpoints")))(vl-string-search qz tx))
(vla-put-Name la (substr tx (1+ (strlen qz)))))))
(princ))

baoxiaozhong

只有简单的去除前缀。

(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)

)

love_cq

非常好的资料，多谢楼主分享。

Ming131564

终于找到了，试试，感谢

290887497

感谢感谢