[求助]：自动转到别的图层

xieyanghui123

eachy斑主，我想请问你一下！你编的这个程序，希望能再改动一下!就更好用了！问题有几个：1用了这个名字就不可以用U返回命令了，2.有了一个关闭命令，希望能再添加一个打开命令。这样就很完美了.

2. 
   
3. (if (not ea:savenew)
   
4.   (setq        ea:savenew
   
5.          (vlr-acdb-reactor
   
6.            "Ea-acdb-reactor"
   
7.            '((:vlr-objectModified . SaveChangedLyr) ;修改
   
8.              (:vlr-objectAppended . SaveChangedLyr) ;添加
   
9.             )
   
10.          )
    
11.   )
    
12. )
    
13. ;;命令监视器
    
14. (if (not ea:chgnew)
    
15.   (setq        ea:chgnew
    
16.          (vlr-editor-reactor
    
17.            nil
    
18.            '((:vlr-commandended . ChgModefied) ;图形内绘制
    
19.              (:vlr-commandcancelled . ChgModefied)
    
20.                                         ;命令中断时检查是否有新实体
    
21.              (:vlr-lispEnded . ChgModefied) ;检查Lisp生成的新实体
    
22.              (:vlr-lispCancelled . ChgModefied) ;中断后是否有新实体
    
23.             )
    
24.          )
    
25.   )
    
26. )
    
27. ;;命令回调
    
28. (defun ChgModefied (var1 var2 / lyrs lyrlst item doc)
    
29.   (setq        lyrs (vla-get-layers
    
30.                (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    
31.              ) ;_vla-get-layers
    
32.   ) ;_setq
    
33.   (if HasChangedObject
    
34.     (progn
    
35.       (vla-startundomark doc)
    
36.       (mapcar
    
37.         '(lambda (item / name lyr lyrobj)
    
38.            (IF (and (not (vlax-erased-p item))
    
39.                     (= (type ea:globlelay) 'STR)
    
40.                     (vlax-property-available-p item 'layer)
    
41.                     (not (vl-catch-all-error-p
    
42.                            (vl-catch-all-apply
    
43.                              'vla-item
    
44.                              (list lyrs ea:globlelay)
    
45.                            )
    
46.                          )
    
47.                     )
    
48.                     (/=        (strcase (vla-get-layer item))
    
49.                         (strcase ea:globlelay)
    
50.                     )
    
51.                );_ end and
    
52.              (progn
    
53. 
    
54.                (if (= (vla-get-lock
    
55.                         (setq lyrobj
    
56.                                (vla-item lyrs
    
57.                                          (setq lyr (vla-get-layer item))
    
58.                                )
    
59.                         )
    
60.                       ) ;_ vla-get-lock
    
61.                       :vlax-true
    
62.                    ) ;_ =
    
63.                  (vla-put-lock lyrobj :vlax-false)
    
64.                ) ;_ if
    
65.                (vla-put-layer item ea:globlelay) ;change layer
    
66.                (vla-put-color item 256)        ;change color to bylayer
    
67.              ) ;_ progn
    
68.            ) ;_ if
    
69.          ) ;_ lambda
    
70.         (vl-remove nil
    
71.                    (mapcar 'vlax-ename->vla-object
    
72.                            HasChangedObject
    
73.                    ) ;_ mapcar
    
74.         ) ;_ vl-remove
    
75.       ) ;_ mapcar
    
76.       (vla-endundomark doc)
    
77.       (setq HasChangedObject nil)
    
78.     ) ;_ progn
    
79.   ) ;_ if
    
80. )
    
81. ;;acdb 回调函数, 保存修改或者新加的实体
    
82. (defun SaveChangedlyr (var1 var2 /)
    
83.   (if (not HasChangedObject)
    
84.     (setq HasChangedObject (list (cadr var2)))
    
85.     (setq HasChangedObject
    
86.            (append (list (cadr var2)) HasChangedObject)
    
87.     ) ;_ setq
    
88.   ) ;_ if
    
89. ) ;_ end defun
    
90. ;;设置修改的图层，使用前请先设定要修改的图层
    
91. (defun c:fvv        (/ str lyr)
    
92.   (if (setq str (getstring "\n输入转换至图层: "))
    
93.     (progn
    
94.       (if (not (tblsearch "layer" str))
    
95.         (progn
    
96.           (setq        lyr
    
97.                  (vla-add (vla-get-layers
    
98.                             (vla-get-activedocument (vlax-get-acad-object))
    
99.                           )
    
100.                           str
     
101.                  )
     
102.           )
     
103.           (vla-put-color lyr 6) ;_可以通过图层管理器修改颜色
     
104.         )
     
105.       )
     
106.       (setq ea:globlelay str)
     
107.     )
     
108.   )
     
109.   (princ)
     
110. )
     
111. (defun c:Removelyr (/)
     
112.   (vlr-remove-all)
     
113.   (setq        ea:savenew
     
114.          nil
     
115.         ea:chgnew nil
     
116.   )
     
117.   (princ "\n\t已取消自动更新图层, 要启用请重新加载本程序!")
     
118.   (princ)
     
119. )
     
120. (princ "\n\t已启用修改自动更新图层功能!")
     
121. (defun c:1111 ( / )
     
122.   (setq h (getreal "\\n 请输入标号字体的高度h:"))
     
123.   (setq bili (getreal "\\n 请输入图纸的比例b:"))
     
124.   (setq h1 (* h bili))
     
125.   (setq n (getint "\\n 请输入标号的最大值n:"))
     
126.   (setq i 1)
     
127.   (while (< i n)
     
128.     (setq pt (getpoint "\\n 请输入标号的位置pt："))
     
129.     (command "text" "m" pt h1 0 (rtos i 2 0))
     
130.     (setq i (+ i 1))
     
131.   )
     
132. )

<br /> (if (not ea:savenew)<br />   (setq        ea:savenew<br />          (vlr-acdb-reactor<br />            "Ea-acdb-reactor"<br />            '((:vlr-objectModified . SaveChangedLyr) ;修改<br />              (:vlr-objectAppended . SaveChangedLyr) ;添加<br />             )<br />          )<br />   )<br /> )<br /> ;;命令监视器<br /> (if (not ea:chgnew)<br />   (setq        ea:chgnew<br />          (vlr-editor-reactor<br />            nil<br />            '((:vlr-commandended . ChgModefied) ;图形内绘制<br />              (:vlr-commandcancelled . ChgModefied)<br />                                         ;命令中断时检查是否有新实体<br />              (:vlr-lispEnded . ChgModefied) ;检查Lisp生成的新实体<br />              (:vlr-lispCancelled . ChgModefied) ;中断后是否有新实体<br />             )<br />          )<br />   )<br /> )<br /> ;;命令回调<br /> (defun ChgModefied (var1 var2 / lyrs lyrlst item doc)<br />   (setq        lyrs (vla-get-layers<br />                (setq doc (vla-get-activedocument (vlax-get-acad-object)))<br />              ) ;_vla-get-layers<br />   ) ;_setq<br />   (if HasChangedObject<br />     (progn<br />       (vla-startundomark doc)<br />       (mapcar<br />         '(lambda (item / name lyr lyrobj)<br />            (IF (and (not (vlax-erased-p item))<br />                     (= (type ea:globlelay) 'STR)<br />                     (vlax-property-available-p item 'layer)<br />                     (not (vl-catch-all-error-p<br />                            (vl-catch-all-apply<br />                              'vla-item<br />                              (list lyrs ea:globlelay)<br />                            )<br />                          )<br />                     )<br />                     (/=        (strcase (vla-get-layer item))<br />                         (strcase ea:globlelay)<br />                     )<br />                );_ end and<br />              (progn<br /> <br />                (if (= (vla-get-lock<br />                         (setq lyrobj<br />                                (vla-item lyrs<br />                                          (setq lyr (vla-get-layer item))<br />                                )<br />                         )<br />                       ) ;_ vla-get-lock<br />                       :vlax-true<br />                    ) ;_ =<br />                  (vla-put-lock lyrobj :vlax-false)<br />                ) ;_ if<br />                (vla-put-layer item ea:globlelay) ;change layer<br />                (vla-put-color item 256)        ;change color to bylayer<br />              ) ;_ progn<br />            ) ;_ if<br />          ) ;_ lambda<br />         (vl-remove nil<br />                    (mapcar 'vlax-ename->vla-object<br />                            HasChangedObject<br />                    ) ;_ mapcar<br />         ) ;_ vl-remove<br />       ) ;_ mapcar<br />       (vla-endundomark doc)<br />       (setq HasChangedObject nil)<br />     ) ;_ progn<br />   ) ;_ if<br /> )<br /> ;;acdb 回调函数, 保存修改或者新加的实体<br /> (defun SaveChangedlyr (var1 var2 /)<br />   (if (not HasChangedObject)<br />     (setq HasChangedObject (list (cadr var2)))<br />     (setq HasChangedObject<br />            (append (list (cadr var2)) HasChangedObject)<br />     ) ;_ setq<br />   ) ;_ if<br /> ) ;_ end defun<br /> ;;设置修改的图层，使用前请先设定要修改的图层<br /> (defun c:fvv        (/ str lyr)<br />   (if (setq str (getstring "\n输入转换至图层: "))<br />     (progn<br />       (if (not (tblsearch "layer" str))<br />         (progn<br />           (setq        lyr<br />                  (vla-add (vla-get-layers<br />                             (vla-get-activedocument (vlax-get-acad-object))<br />                           )<br />                           str<br />                  )<br />           )<br />           (vla-put-color lyr 6) ;_可以通过图层管理器修改颜色<br />         )<br />       )<br />       (setq ea:globlelay str)<br />     )<br />   )<br />   (princ)<br /> )<br /> (defun c:Removelyr (/)<br />   (vlr-remove-all)<br />   (setq        ea:savenew<br />          nil<br />         ea:chgnew nil<br />   )<br />   (princ "\n\t已取消自动更新图层, 要启用请重新加载本程序!")<br />   (princ)<br /> )<br /> (princ "\n\t已启用修改自动更新图层功能!")<br /> (defun c:1111 ( / )<br />   (setq h (getreal "\\n 请输入标号字体的高度h:"))<br />   (setq bili (getreal "\\n 请输入图纸的比例b:"))<br />   (setq h1 (* h bili))<br />   (setq n (getint "\\n 请输入标号的最大值n:"))<br />   (setq i 1)<br />   (while (< i n)<br />     (setq pt (getpoint "\\n 请输入标号的位置pt："))<br />     (command "text" "m" pt h1 0 (rtos i 2 0))<br />     (setq i (+ i 1))<br />   )<br /> )

熊掌设计

ding ding ding

csharp

1 把最开始的两个 if 包装到一个启用命令中
2 可以把移除函数的 setq 注释掉