借鉴前人，做一个去除图层名字0$前缀的插件，图层重命名功能，源码奉上。

i小小白i · 发表于 2024-1-3 15:53

本帖最后由 i小小白i 于 2024-1-3 15:57 编辑

图层重命名之前，由于图纸绑定外参的原因，很多图层名字又臭又长，尤其是带了"0$"这样的前缀，对图纸修改和图层管理来说非常不方便！经过插件重命名之后，图层中带"0$"的前缀都会被去掉，还原图层最原始的名字，如果重命名中出现同名的冲突，插件会在名字的后面增加“0”符号来避免重命名失败。
下方是插件源码，需要的可自行下载。

尘缘一生 · 发表于 2024-1-3 21:35

;所有图层去除【$0$】参照-----(一级)----
;三领设计 V3.0 by 尘缘一生 QQ 15290049
(defun dellay$0$ (/ n obj s2 ss1 ss2 ss3 tc tc1 tc2 x y k kk str1 str2)
(vlax-for n *BLKS*
(if (= :vlax-true (vla-get-IsXRef n))
(setq k t)
)
)
(if (= k t)
(progn
(setq kk
(sl:do1ordo2
(slmsg "当前图纸存在参照,是否绑定?" "讽玡瓜把酚,琌竕﹚?" "The current drawing has reference, bind or not?")
(setq str1 (slmsg "->绑定" "->竕﹚" "->bind"))
(setq str2 (slmsg "放弃" "斌" "Cancel"))
)
)
(if (= kk str1)
(progn
(xblk-xbdcr t)
(command "-xref" "detach" "*")
(setq k nil)
)
)
)
)
(setq ss1 '() ss2 '())
(vlax-for obj *Model-Space* ;取得所有图元
(if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
(setq ss1 (cons (list tc obj) ss1))
)
)
(vlax-for b2 *BLKS* ;查找出所有块
(vlax-for obj b2 ;块里面所有对象
(if (null (vl-catch-all-error-p (setq tc (vl-catch-all-apply 'vla-get-layer (list obj)))))
(setq ss1 (cons (list tc obj) ss1))
)
)
)
(vlax-for obj *LAYS* (setq ss2 (cons (list (vla-get-name obj) obj) ss2))) ;图层集合
(setq
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 (setq n (vl-string-search "|" tc2 0)) (setq tc2 (substr tc2 (+ 2 n))))
(setq tc2 (t-string-subst "" (slmsg "-参照" "-把酚" "-reference") tc2))
(if (= tc2 "") (setq tc2 "0"));如果是空就修改图层为"0"
(if (/= tc2 tc1) ;如果名称发生变化
(if (member (strcase tc2) ss3) ;2;如果已经有这个图层名称
(progn
(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 (and (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj))) (= k nil))
(command "laymrg" "N" tc1 "" "N" tc2 "Y");如果图层不能删除就合并
)
)
(if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list obj tc2))));如果没有相同命名的图层就改变图层名称
(setq ss3 (cons (strcase tc2) ss3))
)
)
)
)
)

囗Peanut囗 · 发表于 2024-1-5 09:16

哈哈哈哈哈哈哈，简直痛苦，不过还挺好用，然后搭配图层合并的插件，效率提升很多，起码合并图层的时候选择起来好选多了。

guokexx · 发表于 2024-1-3 17:27

试试找了好久的的这种插件终于有了看下效率

muai2010 · 发表于 2024-1-3 18:35

能过滤后按规则重命名
么

panliang9 · 发表于 2024-1-4 08:41

谢谢楼主分享

jkop · 发表于 2024-1-4 08:48

好用！外部参考并入的困扰终于解决了，收藏！

jdws213 · 发表于 2024-1-4 15:14

非常感谢楼主的无私！

leedun · 发表于 2024-1-4 16:44

图层重命名功能

菜鸟初来乍到 · 发表于 2024-1-5 08:08

感谢楼主分享

囗Peanut囗 · 发表于 2024-1-5 09:04

这个好啊，先前在坛子里找没有找到，下载下来试试

账号		自动登录	找回密码
密码			注册

借鉴前人，做一个去除图层名字0$前缀的插件，图层重命名功能，源码奉上。

本帖子中包含更多资源

评分

本帖子中包含更多资源