30求选择鼠标点选指定的图层

flytoday

第一、如图这样，命令提示选取，然后鼠标点选下，，然后框选，，只能选择到被点选指定的层等图元，并高亮或虚线显示。被框选到的。。。


第二、框选完成后命令提示：改颜色，改图层名称（可新建一层的），然后鼠标右键结束
第三、但是高亮或虚线显示还体现在界面上，这样方便我执行其它操作，，，。。。。


测试图

feng582304

2. (defun c:asdf ( / s1 ss tt gr n layers color )
   
3.   (setq s1 (entsel "\n请选择参考层:"))
   
4.   (if s1
   
5.     (progn
   
6.       (setq ss (ssget (list (assoc 8 (entget (car s1))))))
   
7.       (if ss
   
8.         (progn
   
9.           (SSSETFIRST ss ss)
   
10.           (INITGET "c l")
    
11.           (setq gr (GETKWORD "\n请选择操作：改颜色(C)，改图层名(L)..."))
    
12.           (cond
    
13.             ((or (= gr "c") (= gr "C"))
    
14.              (if (setq tt (getint "\n请输入修改的颜色:"))
    
15.                (repeat (setq n (sslength ss))
    
16.                  (vla-put-color (vlax-ename->vla-object (ssname ss (setq n (1- n)))) tt)
    
17.                  )
    
18.                )
    
19.              )
    
20.             ((or (= gr "L") (= gr "l"))
    
21.              (if (setq tt (getstring "\n请输入修改的图层名:"))
    
22.                (progn
    
23.                  (setq layers (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))))
    
24.                  (vlax-for n layers (if (= (vla-get-name n) (cdr (assoc 8 (entget (car s1))))) (setq color (vla-get-color n))))
    
25.                  (if (null (TBLSEARCH "layer" tt)) (vla-put-color (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) tt) color))
    
26.                  (repeat (setq n (sslength ss))
    
27.                    (vla-put-layer (vlax-ename->vla-object (ssname ss (setq n (1- n)))) tt)
    
28.                    )
    
29.                  )
    
30.                )
    
31.              )
    
32.             )
    
33.           )
    
34.         )
    
35.       )
    
36.     )
    
37.   )

(defun c:asdf ( / s1 ss tt gr n layers color )<br />   (setq s1 (entsel "\n请选择参考层:"))<br />   (if s1<br />     (progn<br />       (setq ss (ssget (list (assoc 8 (entget (car s1))))))<br />       (if ss<br />         (progn<br />           (SSSETFIRST ss ss)<br />           (INITGET "c l")<br />           (setq gr (GETKWORD "\n请选择操作：改颜色(C)，改图层名(L)..."))<br />           (cond<br />             ((or (= gr "c") (= gr "C"))<br />              (if (setq tt (getint "\n请输入修改的颜色:"))<br />                (repeat (setq n (sslength ss))<br />                  (vla-put-color (vlax-ename->vla-object (ssname ss (setq n (1- n)))) tt)<br />                  )<br />                )<br />              )<br />             ((or (= gr "L") (= gr "l"))<br />              (if (setq tt (getstring "\n请输入修改的图层名:"))<br />                (progn<br />                  (setq layers (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))))<br />                  (vlax-for n layers (if (= (vla-get-name n) (cdr (assoc 8 (entget (car s1))))) (setq color (vla-get-color n))))<br />                  (if (null (TBLSEARCH "layer" tt)) (vla-put-color (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) tt) color))<br />                  (repeat (setq n (sslength ss))<br />                    (vla-put-layer (vlax-ename->vla-object (ssname ss (setq n (1- n)))) tt)<br />                    )<br />                  )<br />                )<br />              )<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )

vormittag

用飞诗的选择易应该可以完成. 不至于悬30币求程序吧。

flytoday

功能指定滴哈

flytoday

看来最近高手都很忙哈。。。。哪位有空路过瞧瞧哈。。。。帮帮忙不胜感激

flytoday

谢谢feng582304 ，技术共享哈。好人啊

lidaxiu

高手，这么快就出程序！

byghbcx

(defun c:tt( / en ss)
    (setq en (car (entsel "\n请选择欲指定图层对象:")))
    (setq ss (ssget (list (assoc 8 (entget en)))))
    (setvar "CMDECHO" 1)
    (command "_.chprop" ss "")
    (while (> (getvar "CmdActive") 0) (command pause))
    (sssetfirst nil ss)
    )

完整武器

8楼的简短精悍 呵呵  都不错

byghbcx

byghbcx 发表于 2011-12-30 15:20
(defun c:tt( / en ss)
    (setq en (car (entsel "\n请选择欲指定图层对象:")))
    (setq ss (ssget ( ...

可以用透明命令'layer增加图层