求助：实现多重复制

andyding

自顶一下，求助。

xiaxiang

这个还是需要自带的copy命令去做，再润色一下就可以了

xiaxiang

2. (defun c:mcopy()
   
3. (vl-load-com)
   
4.   (defun *error* ( msg )
   
5.     (if (and Doc (not (vlax-object-released-p Doc))) (vlax-release-object Doc))
   
6.     (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
   
7.         (princ (strcat "\n** Error: " msg " **")))
   
8.     (princ)
   
9.   )
   
10.    (if (= (getvar "userr3") 0) (setvar "userr3" 20.0))
    
11.    (while (and (princ "\n选择图元 :")
    
12.                (setq ss (ssget))
    
13.                (setq p1 (getpoint "\n起始点 :")))
    
14.    (setq p2 (getpoint "\n终止点<回车输入方向和距离>: "))
    
15.      (if (= p2 nil)  
    
16.     (progn   
    
17.   (setq ang (getangle p1 "\n方向 :"))
    
18.     (if (setq ll (getdist (strcat "\n距离<" (rtos (getvar "userr3")) ">:")))
    
19.    (setvar "userr3" ll)
    
20.      (setq ll (getvar "userr3"))
    
21.     )
    
22.   (setq p2 (polar p1 ang (/ ll bl)))
    
23.   )
    
24.   (command ".COPY" ss "" "m" p1 p2)
    
25.   )
    
26.     (command ".COPY" ss ""  p1 p2)
    
27.    )
    
28.   (princ)
    
29. )

(defun c:mcopy()<br /> (vl-load-com)<br />   (defun *error* ( msg )<br />     (if (and Doc (not (vlax-object-released-p Doc))) (vlax-release-object Doc))<br />     (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")<br />         (princ (strcat "\n** Error: " msg " **")))<br />     (princ)<br />   )<br />    (if (= (getvar "userr3") 0) (setvar "userr3" 20.0))<br />    (while (and (princ "\n选择图元 :")<br />                (setq ss (ssget))<br />                (setq p1 (getpoint "\n起始点 :")))<br />    (setq p2 (getpoint "\n终止点<回车输入方向和距离>: "))<br />      (if (= p2 nil)  <br />     (progn   <br />   (setq ang (getangle p1 "\n方向 :"))<br />     (if (setq ll (getdist (strcat "\n距离<" (rtos (getvar "userr3")) ">:")))<br />    (setvar "userr3" ll)<br />      (setq ll (getvar "userr3"))<br />     )<br />   (setq p2 (polar p1 ang (/ ll bl)))<br />   )<br />   (command ".COPY" ss "" "m" p1 p2)<br />   )<br />     (command ".COPY" ss ""  p1 p2)<br />    )<br />   (princ)<br /> )

andyding

回复 xiaxiang 的帖子

谢谢指点！
程序有错误，小问题， (setq p2 (polar p1 ang (/ ll bl)))      bl变量可能是笔误了。
多加一个方向条件是可以实现的。
我原本的设想是不是不可能实现？

xiaxiang

回复 andyding 的帖子

不好意思啊。
你那个要求应该可以实现的。就是要绕点弯子。
是个好的思路！

xiaxiang

用这个函数acet-ss-drag-move
理所当然，需要扩展工具支持。

andyding

xiaxiang 发表于 2011-8-12 16:29
用这个函数acet-ss-drag-move
理所当然，需要扩展工具支持。

可否开源让我学习一下？其实这个多重复制的功能有没有不重要，我想学习这个方法。

xiaxiang

其实几行代码就能写出来，不用扩展工具。
这个代码暂时没实现记忆功能，不过也不难。

andyding

xiaxiang 发表于 2011-9-20 11:54
其实几行代码就能写出来，不用扩展工具。
这个代码暂时没实现记忆功能，不过也不难。

跟我的要求相差甚远。

多重复制，记忆距离。有两种模式。左键点了，就复制到左键点的这个点。
左键不点，按空格、回车依记忆的距离和鼠标及时所指的方向去复制。
复制基点自动跳到最后复制出来的这个对象的相应的位置上。
我发在一楼的那个程序基本可以实现，就是出错率太高，不精确。

xiaxiang

andyding 发表于 2011-9-20 15:26
跟我的要求相差甚远。

多重复制，记忆距离。有两种模式。左键点了，就复制到左键点的这个点。

差一个记忆距离。我26#那个就可以实现