移动层内的所有对象
我Lisp程序（我记不起编码员！）这是通过在图形上选择将层内的所有对象移动到目标层，然后更改属性并合并空层。它工作正常，但根据我的需要，我不希望命令行提示层命名，我想进入预定义的“门”层。也可能是多选而不是一选吗？
非常感谢。
MOVOBJS。lsp 为什么不在宏中使用laymrg命令？ 它将成为DCL表单的一部分，还有其他带有laymrg的命令行提示符。 这是一个多选择版本，在警报后检查额外的时间
(defun c:MOVOBJS ( / a b s )
(defun *error* (msg) (setvar "cmdecho" 1)
(setq a nil b nil s nil)(princ) );end**
(graphscr)
(if (not usermel) (setq usermel "DOORS") );if
(setq a (strcase (getstring (strcat
"Move Entire Layer \nEnter destination layer <" usermel ">: "))))
(if (= (strlen a) 0) (setq a usermel) );if
(if (> (strlen a) 0)
(progn
(while (not (tblsearch "layer" a))
(if (and (> (strlen a) 0) (/= a "Entry") );and
(progn
(initget "Yes No")
(setq b (getkword (strcat "\n" a " not in drawing base, "
"create this layer? <No>: "))) );progn
(setq a "Entry") );if
(if (= b "Yes")
(progn
(setvar "cmdecho" 0)
(command ".layer" "n" a "")
(if (/= (substr (getvar "clayer") 1 2) (substr a 1 2))
(command ".layer" a "") );if
(princ (strcat "\nLayer " a " created and frozen. "))
(setvar "cmdecho" 1) );progn
(setq a (strcase (getstring (strcat
"\n" a " invalid. Enter destination layer: ")))) );if
(setq b nil) );while
(setq usermel a) );progn
);if
(if (tblsearch "layer" usermel)
(progn
(Alert "Pick a object or pick nothing to exit)
(while (setq a (entget (car (entsel "\nSelect an object: "))))
(setq s (ssget "x" (list (cons 8 (cdr (assoc 8 a))))))
(setvar "cmdecho" 0)
(command ".chprop" s "" "la" usermel "")
(setvar "cmdecho" 1)
(princ (strcat "\n" (itoa (sslength s)) " object(s) on layer "
(cdr (assoc 8 a)) " moved to layer " usermel "."))
) ; while
);progn
);if
(setq a nil s nil)(princ)
(COMMAND "-LAYER" "C" "122" "DOORS" "")
(vlax-for layout (vla-get-layouts
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (/= (vla-get-name layout) "Model")
(vla-delete layout)
)
)
(command "-purge" "all" "*" "N")
)
谢谢比格尔的修改。多选现在工作（我调试它有点错误），但我仍然得到用户提示，以确认层命名和。。。如下所示：
命令：MOVOBJS
移动整个层
输入目标图层：-门不在图形库中，是否创建此图层？[是/否]：是无效选项关键字>
输入选项？>
[？/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck
/解锁/状态/描述/协调]：*取消*-命令：MOVOBJS移动整个层
输入目标层：
选择对象：
层3上的1个对象移动到层门。
选择对象：
层1上的1个对象移动到层门。
令人惊讶的是，清除不起作用。
附件是新版本。
非常感谢
MOVOBJS。lsp 我有一个lisp，它可以很好地处理单选。如何通过选择一个项目将其移动到目标层来修改此选项以移动整个层？
非常感谢
MOVOBJS2.lsp 加载后的一个建议是，不要键入您键入的movobjs（movobjs“Doors”），然后代码可以删除层“Doors”的硬编码，相反，例程会变得更通用，任何层名称都是目标名称。
建议2最好编写一个小defun来检查是否缺少层。好的是，您可以将其放入LISP库中，并根据需要从任何程序中调用。（chklay“doors”3“continuous”）
; NOT TESTED
(defun c:MOVOBJS (usermel / a b s )
(defun *error* (msg) (setvar "cmdecho" 1)
(setq a nil b nil s nil)(princ) );end**
(graphscr)
(if (= usermel nil) (setq usermel "DOORS") );if
(setq usermel (strcase usermel))
(setq laysrch (tblsearch "layer" usermel))
(if (= laysrch nil)
(command ".layer" "n" usermel "C" "122" usermel "")
(princ "layer exists")
)
(Alert "Pick a object or pick nothing to exit")
(while (setq a (entget (car (entsel "\nSelect an object: "))))
(setq s (ssget "x" (list (cons 8 (cdr (assoc 8 a))))))
(setvar "cmdecho" 0)
(command ".chprop" s "" "la" usermel "")
(setvar "cmdecho" 1)
(princ (strcat "\n" (itoa (sslength s)) " object(s) on layer "
(cdr (assoc 8 a)) " moved to layer " usermel "."))
) ; while
(vlax-for layout (vla-get-layouts
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (/= (vla-get-name layout) "Model")
(vla-delete layout)
)
(command "-purge" "all" "*" "N")
(command "-purge" "all" "*" "N") ; sometimes need 2
) ;defun
抱歉，伙计，出现了“错误：参数太少”并试图解决它。谢谢
页:
[1]