kucha007 发表于 2024-1-29 11:06
已改写，再看看
可以多选了，但是图层不能置为当前，比如选中3个图层单开，使其任意1个图层置为当前都行
cj52000 发表于 2024-1-29 13:40
可以多选了，但是图层不能置为当前，比如选中3个图层单开，使其任意1个图层置为当前都行
你任意图层都行是吧……多个对象也是随机一个图层就行？
kucha007 发表于 2024-1-29 13:57
你任意图层都行是吧……多个对象也是随机一个图层就行？
嗯嗯，是的大佬
cj52000 发表于 2024-1-29 14:15
嗯嗯，是的大佬
(defun c:TT (/ DOC LayLst SS i obj Lay LayOpen)
(if (null vlax-dump-object) (vl-load-com));;将Visual LISP扩展功能加载到AutoLISP
(setq DOC (vla-get-activedocument (vlax-get-acad-object))
LayLst (vla-get-layers DOC)
)
(defun *error* (Msg)
(vla-endundomark DOC)
)
(while (eq 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark DOC)
) ;关闭以前的编组
(vla-startundomark DOC) ;记录编组
(if
(and
(princ "\n——★★★ 请选择需要保留图层的对象 ★★★——\n")
(setq SS (ssget))
)
(progn
(vlax-for XX LayLst (vla-put-layeron XX :vlax-false)) ;图层全关
(repeat (setq i (sslength SS))
(setq obj (vlax-ename->vla-object (ssname SS (setq i (1- i))))
Lay (vla-get-Layer obj)
)
(if (not (vl-position Lay LayOpen))
(progn
(vla-put-layeron (vla-item LayLst Lay) :vlax-true) ;打开目标图层
(setq LayOpen (cons Lay LayOpen))
)
)
);关闭其它
(setvar "CLAYER" (car LayOpen)) ;图层置为当前
(princ "\n——★★★ 已关闭除所选对象以外的其它图层 ★★★——\n")
)
)
(vla-endundomark DOC) ;结束编组
(command "redraw")
(princ)
)
kucha007 发表于 2024-1-29 14:23
可以了，感谢！
vitalgg 发表于 2024-1-28 21:50
源码：
https://gitee.com/atlisp/packages/blob/main/at-layer/at-layer.lsp
看着挺好，不知道咋用
paulpipi 发表于 2024-1-29 17:30
看着挺好，不知道咋用
想直接用更简单。
复制以下代码到CAD命令行，回车安装即可。
(progn(vl-load-com)(setq s strcat h "http" o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://atlisp.""cn/@"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
kucha007 发表于 2024-1-29 14:23
不错，正常使用，能加个不选对象时回车后恢复图层会更方便一点
试试这个
(Defun C:y (/ ss ct cl la old)
(setvar "cmdecho" 0)
(setq ss (ssget))
(setq ct 0
len (sslength ss)
cl (cdr (assoc 8 (entget (ssname ss 0))))
)
(setvar "clayer" cl)
(while (< ct len)
(setq la (cdr (assoc 8 (entget (ssname ss ct)))))
(if (= old nil)
(setq OLD la)
(setq OLD (strcat OLD "," la))
)
(setq ct (1+ ct))
)
(command ".layer" "off" "*" "n" "")
(command ".layer" "on" old "")
(setvar "CECOLOR" (itoa (cdr (assoc 62 (tblsearch "layer" (getvar "CLAYER"))))))
(princ)
)
kucha007 发表于 2024-1-29 14:23
真好用，感谢分享