（完成）[编程申请]：copy offset 实体到当前层

doongs

人总是越来越懒了，请求编程copy offset实体到当前层上，ＣＡＤ原本的命令新生成的实体和源实体在一个层上，总是要多转换一下

eachy

最初由 doongs 发布
[B]人总是越来越懒了，请求编程copy offset实体到当前层上，ＣＡＤ原本的命令新生成的实体和源实体在一个层上，总是要多转换一下 [/B]

用命令反应器好些。

e2002

是可以作个反应器,命令完成后给出提示是否修改到当前层,OK修改Cancel取消

snsj

我觉得用发应器完全实现不太可能，CAD的发应器不够完善，局限性也很大
比如COPY中使用多重拷贝或者OFFSET中多重偏移发应器就察觉不到
其只对开始和结果作用，至于中间是否使用了多重命令是无法生效的

doongs

最初由 eachy 发布
[B]
用命令反应器好些。 [/B]

怎么用？能具体一点吗？谢谢！

snsj

最初由 doongs 发布
[B]
怎么用？能具体一点吗？谢谢！ [/B]

刚开始理解错了，想想倒是可以实现，先只用命令发应器实现一个，一会再试试另一种方法

2. 
   
3. ;;;|偏移、拷贝物体自动转化到当前层程序
   
4. ;;;|程序加载后在图形关闭前有效
   
5. ;;;|snsj 2004.3.22
   
6. (defun rev-ty-n (gx / i kj ent entity doc)
   
7. (vl-load-com)(setq i 1)
   
8. (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
   
9. (if (= (vla-get-ActiveSpace doc) acModelSpace)
   
10. (setq entity (vla-get-ModelSpace doc))
    
11. (setq entity (vla-get-PaperSpace doc))
    
12. )
    
13.   (repeat gx
    
14. (setq ent (vlax-vla-object->ename
    
15. (vla-Item entity (- (vla-get-count entity) i))))
    
16.     (setq kj (cons ent kj))
    
17.     (setq i (1+ i))
    
18.           )
    
19.   kj
    
20. )
    
21. ;--------------------------------------------------------------------
    
22. (vlr-command-reactor nil '((:vlr-commandWillStart . startCommand)))
    
23. (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))
    
24. ;--------------------------------------------------------------------
    
25. (defun startCommand (calling-reactor startcommandInfo /)
    
26. (if(or(= (nth 0 startcommandInfo) "OFFSET")(= (nth 0 startcommandInfo) "COPY"))
    
27.   (setq apple-qjbl-etlast (entlast))
    
28.   )
    
29.   )
    
30. ;------------------------------------------------------------------------------
    
31. (defun endCommand (calling-reactor endcommandInfo / lstleng i  x)
    
32.   (cond((or(= (nth 0 endcommandInfo) "OFFSET")(= (nth 0 endcommandInfo) "COPY"))
    
33. (setq i 1)
    
34.   (while (=(length(vl-remove apple-qjbl-etlast (setq lstleng(rev-ty-n i))))(length lstleng))
    
35.     (setq i (1+ i))
    
36.     )        
    
37.   (mapcar '(lambda (y)
    
38.              (if (/=(vla-get-layer(vlax-ename->vla-object y))(getvar "clayer"))
    
39.              (vla-put-layer(vlax-ename->vla-object y)(getvar "clayer"))
    
40.              )
    
41.              )
    
42.           (rev-ty-n (- i 1))
    
43.           )
    
44.     ))
    
45.   )
    

<br /> ;;;|偏移、拷贝物体自动转化到当前层程序<br /> ;;;|程序加载后在图形关闭前有效<br /> ;;;|snsj 2004.3.22<br /> (defun rev-ty-n (gx / i kj ent entity doc)<br /> (vl-load-com)(setq i 1)<br /> (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))<br /> (if (= (vla-get-ActiveSpace doc) acModelSpace)<br /> (setq entity (vla-get-ModelSpace doc))<br /> (setq entity (vla-get-PaperSpace doc))<br /> )<br />   (repeat gx<br /> (setq ent (vlax-vla-object->ename<br /> (vla-Item entity (- (vla-get-count entity) i))))<br />     (setq kj (cons ent kj))<br />     (setq i (1+ i))<br />           )<br />   kj<br /> )<br /> ;--------------------------------------------------------------------<br /> (vlr-command-reactor nil '((:vlr-commandWillStart . startCommand)))<br /> (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))<br /> ;--------------------------------------------------------------------<br /> (defun startCommand (calling-reactor startcommandInfo /)<br /> (if(or(= (nth 0 startcommandInfo) "OFFSET")(= (nth 0 startcommandInfo) "COPY"))<br />   (setq apple-qjbl-etlast (entlast))<br />   )<br />   ) <br /> ;------------------------------------------------------------------------------<br /> (defun endCommand (calling-reactor endcommandInfo / lstleng i  x)<br />   (cond((or(= (nth 0 endcommandInfo) "OFFSET")(= (nth 0 endcommandInfo) "COPY"))<br /> (setq i 1)<br />   (while (=(length(vl-remove apple-qjbl-etlast (setq lstleng(rev-ty-n i))))(length lstleng))<br />     (setq i (1+ i))<br />     )        <br />   (mapcar '(lambda (y)<br />              (if (/=(vla-get-layer(vlax-ename->vla-object y))(getvar "clayer"))<br />              (vla-put-layer(vlax-ename->vla-object y)(getvar "clayer"))<br />              )<br />              )<br />           (rev-ty-n (- i 1))<br />           )<br />     ))<br />   )<br />

snsj

加上拷贝过程用取消结束命令的情况
[php]
;;;|偏移、拷贝物体自动转化到当前层程序
;;;|程序加载后在图形关闭前有效
;;;|snsj 2004.3.22
---------------------------------------------------------------------------
;;;|修改数据通用函数
(defun rev-ty-n (gx / i kj ent entity doc)
(vl-load-com)(setq i 1)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (= (vla-get-ActiveSpace doc) acModelSpace)
(setq entity (vla-get-ModelSpace doc))
(setq entity (vla-get-PaperSpace doc))
)
  (repeat gx
(setq ent (vlax-vla-object->ename
(vla-Item entity (- (vla-get-count entity) i))))
    (setq kj (cons ent kj))
    (setq i (1+ i))
          )
  kj
)
(defun xg (/ i y)
(setq i 1)
  (while (null(member apple-qjbl-etlast (rev-ty-n i)))
    (setq i (1+ i))
    )        
  (mapcar '(lambda (y)
             (if (/=(vla-get-layer(vlax-ename->vla-object y))(getvar "clayer"))
             (vla-put-layer(vlax-ename->vla-object y)(getvar "clayer"))
             )
             )
          (rev-ty-n (- i 1))
          )
  )
;;;|建立发应器
(vlr-command-reactor nil '((:vlr-commandWillStart . startCommand)))
(vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))
(vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))
;;;|激活反应器
(defun startCommand (calling-reactor startcommandInfo /)
(if(or(= (nth 0 startcommandInfo) "OFFSET")(= (nth 0 startcommandInfo) "COPY"))
  (setq apple-qjbl-etlast (entlast))
    )
  );激活开始反应器
(defun endCommand (calling-reactor endcommandInfo /)
  (if(or(= (nth 0 endcommandInfo) "OFFSET")(= (nth 0 endcommandInfo) "COPY"))
        (xg))
  );激活结束反应器
(defun cancelCommand (calling-reactor cancelcommandInfo /)
(if(or(= (nth 0 cancelcommandInfo) "OFFSET")(= (nth 0 cancelcommandInfo) "COPY"))
        (xg))
  );激活取消反应器
   [/php]

eachy

最初由 snsj 发布
[B]加上拷贝过程用取消结束命令的情况
;;;|偏移、拷贝物体自动转化到当前层程序
;;;|程序加载后在图形关闭前有效
;;;|snsj 2004.3.22
-------------------------------------------------------------... [/B]

把上面的修改了下

2. 
   
3. [PHP]
   
4. ;;;|建立发应器
   
5. (vlr-command-reactor
   
6.   nil
   
7.   '((:vlr-commandWillStart . startCommand))
   
8. )
   
9. (vlr-command-reactor
   
10.   nil
    
11.   '((:vlr-commandEnded . endCommand))
    
12. )
    
13. (vlr-command-reactor
    
14.   nil
    
15.   '((:vlr-commandCancelled . cancelCommand))
    
16. )
    
17. ;;修改实体函数
    
18. (defun change-copy-offset-object (/ apple-new-object-number obj space)
    
19.   (setq        space (vlax-get-property
    
20.                 (vla-get-activedocument
    
21.                   (vlax-get-acad-object)
    
22.                 )
    
23.                 (if (= (getvar "tilemode") 1)
    
24.                   'modelspace
    
25.                   'paperspace
    
26.                 )
    
27.               )
    
28.   )
    
29.   ;;命令结束或取消时空间实体的数量
    
30.   (setq apple-new-object-number (vla-get-count space))
    
31.   (if (> apple-new-object-number apple-object-number);有新实体
    
32.     (progn
    
33.       (repeat (- apple-new-object-number apple-object-number)
    
34.         (setq
    
35.           obj (vla-item
    
36.                 space
    
37.                 (1- apple-new-object-number)
    
38.               )
    
39.         )
    
40.         (if (/= (vla-get-layer obj) (getvar "clayer"))
    
41.           (vla-put-layer obj (getvar "clayer"))
    
42.         )
    
43.         (setq apple-new-object-number (1- apple-new-object-number))
    
44.       )
    
45.     )
    
46.   )
    
47.   (setq apple-object-number nil)
    
48. )
    
49. ;;;|命令反应器回调函数
    
50. (defun startCommand (calling-reactor startcommandInfo /)
    
51.   (if (or (= (nth 0 startcommandInfo) "OFFSET")
    
52.           (= (nth 0 startcommandInfo) "COPY")
    
53.       )
    
54.     ;;命令开始记录空间实体数量
    
55.     (setq apple-object-number
    
56.            (vla-get-count
    
57.              (vlax-get-property
    
58.                (vla-get-activedocument
    
59.                  (vlax-get-acad-object)
    
60.                )
    
61.                (if (= (getvar "tilemode") 1)
    
62.                  'modelspace
    
63.                  'paperspace
    
64.                )
    
65.              )
    
66.            )
    
67.     )
    
68.   )
    
69. )
    
70. ;;;命令结束回调
    
71. (defun endCommand (calling-reactor endcommandInfo /)
    
72.   (if (or (= (nth 0 endcommandInfo) "OFFSET")
    
73.           (= (nth 0 endcommandInfo) "COPY")
    
74.       )
    
75.     (change-copy-offset-object)
    
76.   )
    
77. )
    
78. ;;命令取消激活取消反应器
    
79. (defun cancelCommand (calling-reactor cancelcommandInfo /)
    
80.   (if (or (= (nth 0 cancelcommandInfo) "OFFSET")
    
81.           (= (nth 0 cancelcommandInfo) "COPY")
    
82.       )
    
83.     (change-copy-offset-object)
    
84.   )
    
85. )[/PHP]

<br /> [PHP]<br /> ;;;|建立发应器<br /> (vlr-command-reactor<br />   nil<br />   '((:vlr-commandWillStart . startCommand))<br /> )<br /> (vlr-command-reactor<br />   nil<br />   '((:vlr-commandEnded . endCommand))<br /> )<br /> (vlr-command-reactor<br />   nil<br />   '((:vlr-commandCancelled . cancelCommand))<br /> )<br /> ;;修改实体函数<br /> (defun change-copy-offset-object (/ apple-new-object-number obj space)<br />   (setq        space (vlax-get-property<br />                 (vla-get-activedocument<br />                   (vlax-get-acad-object)<br />                 )<br />                 (if (= (getvar "tilemode") 1)<br />                   'modelspace<br />                   'paperspace<br />                 )<br />               )<br />   )<br />   ;;命令结束或取消时空间实体的数量<br />   (setq apple-new-object-number (vla-get-count space))<br />   (if (> apple-new-object-number apple-object-number);有新实体<br />     (progn<br />       (repeat (- apple-new-object-number apple-object-number)<br />         (setq<br />           obj (vla-item<br />                 space<br />                 (1- apple-new-object-number)<br />               )<br />         )<br />         (if (/= (vla-get-layer obj) (getvar "clayer"))<br />           (vla-put-layer obj (getvar "clayer"))<br />         )<br />         (setq apple-new-object-number (1- apple-new-object-number))<br />       )<br />     )<br />   )<br />   (setq apple-object-number nil)<br /> )<br /> ;;;|命令反应器回调函数<br /> (defun startCommand (calling-reactor startcommandInfo /)<br />   (if (or (= (nth 0 startcommandInfo) "OFFSET")<br />           (= (nth 0 startcommandInfo) "COPY")<br />       )<br />     ;;命令开始记录空间实体数量<br />     (setq apple-object-number<br />            (vla-get-count<br />              (vlax-get-property<br />                (vla-get-activedocument<br />                  (vlax-get-acad-object)<br />                )<br />                (if (= (getvar "tilemode") 1)<br />                  'modelspace<br />                  'paperspace<br />                )<br />              )<br />            )<br />     )<br />   )<br /> )<br /> ;;;命令结束回调 <br /> (defun endCommand (calling-reactor endcommandInfo /)<br />   (if (or (= (nth 0 endcommandInfo) "OFFSET")<br />           (= (nth 0 endcommandInfo) "COPY")<br />       )<br />     (change-copy-offset-object)<br />   )<br /> )<br /> ;;命令取消激活取消反应器<br /> (defun cancelCommand (calling-reactor cancelcommandInfo /)<br />   (if (or (= (nth 0 cancelcommandInfo) "OFFSET")<br />           (= (nth 0 cancelcommandInfo) "COPY")<br />       )<br />     (change-copy-offset-object)<br />   )<br /> )[/PHP]

hancebueg

code该怎么使用？

eachy

最初由 hancebueg 发布
[B]code该怎么使用？ [/B]

复制-〉到记事本粘贴-〉保存为Lsp文件，到CAD加载。详细使用到教学中心察看教程。

说明：上面的程序可以完成楼主的要求，但还是比较简单的，对比下 autolayer 就知道了，其中的反应器没有管理部分，慎用。

*秋*

也真有和我一样的懒人，这是我一直想要的东东
试用了一下，当我完成了我需要的工作，想恢复正常拷贝时要怎么操作？想去卸载这个lisp程序，结果不行

conn

搞个r14的
; 复制到当前层（copy_to_layer）。
;本程序将复制一个实体到当前层无论它在哪个层。

(defun C:test ()
    (setvar "cmdecho" 0)
    (setq c_layer (getvar "clayer")
          sset (ssget)
          pt1 (getpoint "\n基点： ")
          count 0)
   (prompt "\n位移的第二点： ")
      (setq  len (sslength sset))
      (while (< count len)
       (setq name (ssname sset count)
             ptlst (entget name)
             b (assoc 8 ptlst)
             b1 (cdr (assoc 8 ptlst))
             c (cons 8 c_layer)
             d (subst c b ptlst)
             count (1+ count))
            (entmod d)
     )
    (command "_copy" sset "" pt1 pause)
    (setq count 0)
    (while (< count len)
    (setq name (ssname sset count)
             ptlst (entget name)
             b (assoc 8 ptlst)
             c (cons 8 b1)
             d (subst c b ptlst)
             count (1+ count))
            (entmod d)
     )
     (princ)
   )

xxhlovekr

楼上的实在是太强了
可是我是刚学的菜鸟,不太明白啊
郁闷

snsj

最初由 conn 发布
[B]搞个r14的
; 复制到当前层（copy_to_layer）。
;本程序将复制一个实体到当前层无论它在哪个层。

(defun C:test ()
    (setvar "cmdecho" 0)
    (setq c_layer (getvar "clayer")
          sset (ssget)
... [/B]

你看清楚，上面的程序是不用再拷贝的，只要使用COPY命令和OFFEST就会自动转的～～～～
用LISP命令实现非常简单见
http://www.xdcad.net/forum/showt ... d=866808#post866808

eachy

最初由 aeo 发布
[B]总觉得不是个事情！
改进：
　add-it,加入反应器，再重复命令，取消反应器 ......
     mirror ,array也加入
  上面的如果命令打成 .copy _offset好象不行，改进之.
    当然还可以加入pasteclip,自己加吧，多?.. [/B]

还可以改进，用一个全局变量控制新生成实体所要到的层，另外对反应器的管理上还有待完善，这方面的例子可见到的就是 autolayer 是比较全面的。