求 删除 绑定参照的 图层、线型、尺寸标注、文字样式的名字前缀
本帖最后由 hongxibao 于 2018-9-16 12:32 编辑麻烦大侠帮个忙！写个lsp
绑定参照后，把带进的 图层、线型、尺寸标注、文字样式的名字$0$之前的前缀全部删掉（图纸说不定被二次参照，名字带有两个或三个、n个$0$）
删除前缀时，如果有名字重合，则可以合并名字，如果不能合并，就在名字后面加个数字，比如1（加数字后，如果还有重合，继续循环运行加数字1，直到不重合）
本帖最后由 437271963 于 2018-11-30 16:51 编辑
(defun c:tes ( / doc msp n obj s2 ss1 ss2 ss3 tc1 tc2 x y)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-dump-object) (vl-load-com) )
(s1811301);修改图层名称
(princ)
)
;修改图层名称
(defun s1811301 ( / doc n obj s2 ss1 ss2 ss3 tc1 tc2 x y)
(setq doc (vla-get-activedocument (vlax-get-acad-object));取得当前所有对象集合
msp (vla-get-ModelSpace doc);取得模型空间
ss1 (s1811302 doc msp);取得所有对象
ss2 (w1810232 doc);图层集合
ss3 (mapcar 'strcase (mapcar 'car ss2));图层名称集合
tc1 (getvar "clayer");取得当前图层名称
)
(if (or (vl-string-search "\#" tc1 0) (vl-string-search "$" tc1 0)) (setvar "clayer" "0") );如果当前图层需要修改，就转换图层为"0"
(while (setq s2 (car ss2));处理图层
(setq ss2 (cdr ss2) tc1 (car s2) tc2 tc1 obj (cadr s2))
(while (vl-string-search "\#" tc2 0) (setq tc2 (vl-string-subst "" "\#" tc2)));处理有#的图层名称
(while (setq n (vl-string-search "$" tc2 0)) (setq tc2 (substr tc2 (+ 2 n))));处理有$的图层名称
(if (= tc2 "") (setq tc2 "0") );如果是空就修改图层为"0"
(if (/= tc2 tc1);如果名称发生变化
(progn;;1
(if (member (strcase tc2) ss3);2;如果已经有这个图层名称
(progn;;2
(mapcar '(lambda (y) (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-layer (list y tc2))))
(mapcar 'cadr
(vl-remove-if-not '(lambda (x) (= (car x) tc1)) ss1);取得所有TC1的对象
);提取出图元名称
);所有这个图层的所有图元改变图层
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)));删除这个图层
(progn
(Command "laymrg" "N" tc1 "" "N" tc2 "Y");如果图层不能删除就合并
)
);if;4
);progn;2-1
(progn;;2-2
(if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list obj tc2))));如果没有相同命名的图层就改变图层名称
(setq ss3 (cons (strcase tc2) ss3))
);if;3
);progn;2-2
);if;2
);progn;1
);if;1
);while
)
;取得所有图层名称
(defun w1810232 (doc / doc lay obj ss tc)
(setq lay (vla-get-layers doc) ss '())
(vlax-for obj lay
(setq tc (vla-get-name obj));取得图层名称
(setq ss (cons (list tc obj) ss))
)
ss
)
;提取所有图元
(defun s1811302 (doc msp / b1 b2 doc msp obj ss tc)
(setq ss '())
(vlax-for obj msp;取得所有图元
(if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
(setq ss (cons (list tc obj) ss))
)
)
(setq b1 (vla-get-blocks doc));取得所有块集合
(vlax-for b2 b1;查找出所有块
(vlax-for obj b2;块里面所有对象
(if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
(setq ss (cons (list tc obj) ss))
)
)
)
ss
)
;;一键所有图层去除【$0$】
;;-------------------------------------------
有大侠可以帮忙吗 试用过了，改不了，请大侠复核一下 437271963 发表于 2018-9-16 11:09
谢谢大侠帮助 好东西 谢谢 感谢作者的分享！
页:
[1]