(defun C:AutoLayerChange ( / L _LayersList _Recapitalise lyrs SS i enx lyr tmp )
(setq L ; Note: layer names are case insensitive - assoc list of: (<old layer> . <new layer>)
'( ; Place your inputs here:
("obj2" . "obj1")
("dim" . "0")
); list
); setq L
(defun _LayersList ( / d L )
(while (setq d (tblnext "LAYER" (not d)))
(setq L (cons (cdr (assoc 2 d)) L))
)
)
(defun _Recapitalise ( itm L )
(vl-some (function (lambda (x) (if (= (strcase itm) (strcase x)) x))) L)
)
(and
(setq lyrs (_LayersList))
(or
(setq L (apply (function append) (mapcar (function (lambda (x / tmp) (if (setq tmp (_Recapitalise (car x) lyrs)) (list (cons tmp (cdr x)))))) L)))
(prompt "\nNo valid layers were found.")
); or
(or
(prompt "\nSelect objects to change layers: ")
(setq SS (ssget "_:L-I" (list (cons 8 (setq tmp (substr (apply (function strcat) (mapcar (function (lambda (x) (strcat "," (car x)))) L)) 2))))))
(prompt (strcat "\nNo objects were found on \"" tmp "\"layers."))
); or
(repeat (setq i (sslength SS))
(setq enx (entget (ssname SS (setq i (1- i)))))
(setq lyr (assoc 8 enx))
(entmod (subst (cons 8 (cond ( (cdr (assoc (setq tmp (cdr lyr)) L)) ) ( tmp ) )) lyr enx))
); repeat
); and
(princ)
); defun C:AutoLayerChange
=
Your Code Here
嗨，塔瓦，
谢谢你的建议。。关于视口，我有一个问题：
用户选择视口对象的情况是什么？在文书空间工作时（我猜）？
我总是在模型空间中工作，所以我从来没有考虑过这个问题的可能性。
顺便说一句，对于第二句话，我实际上没有查看目标层是否已经存在-只是确保OP是否提供了点对列表：
Your Code Here
但我同意使用同一层的entmod有点效率低下。 下次会处理好的，谢谢你的提醒。
我们无法猜测所有用户都在模型空间中工作。
同意这一点，但这将忽略将对象移动到目标层，如果它不存在，这就是重点。
希望我的评论没有引起任何混乱。
如果你能帮我查一下萨提斯的代码，为什么它在我的系统上不起作用？有什么想法吗？
测验 Solitechcadsolutions，您需要向所有希望帮助您的成员清楚地描述您的计划目标，并为此编写正确的代码。
例如；
您试图将哪些对象移动到该新图层名？
您想选择某些对象还是让程序全部选择？
你有解锁层上的对象吗？
等等 我同意使用关联列表，但是代码可以大大简化，例如-
'( ; The routine will skip entmod'ing "Layer1"
("obj2" . "obj1")
("dim" . "0")
("Layer1")
)
不错，李，
我不知道你可以像那样过滤层，忽略他们名字的大小写！ 谢谢李和grr，代码对我来说工作得很好。。。。
太棒了
页:
1
[2]