[编程申请]：帮忙做个连继复制的工具

linsw9606

可否用lisp编写的这样一个单独功能的复制工具,在原cad的复制的基础上，使用的时候，复制一次，在命令没结束的情况下，重复的按空键，就可以第一次复制的方向和距离一直复制下去，直到按ESC退出结束。

(要求类似lisp编写以的独立程序，方便在cad里加载使用，命令为ccf,能支持同时选多个物体进行操做。）

本人联系方式qq 180264877
邮箱:9613406@163.com

附件是个朋友做的,但没做好,不能支持多个物体操作.命令为ccc,可以参考参考.

wangyuhui82

跟array命令有点像

linsw9606

跟array一点都不象呀,要说象应该就是复制,其实就是复制,只是换一个方式(按空健实现)连续复制,这样用起来会很简单方便,又很直观,可是就是找不到,哪位大侠做一个发到我好吗?以上附件因为不能支持多个物体的操作,只能算是半成品,最好是lisp的.

gysjy

最初由 linsw9606 发布
[B]可否用lisp编写的这样一个单独功能的复制工具,在原cad的复制的基础上，使用的时候，复制一次，在命令没结束的情况下，重复的按空键，就可以第一次复制的方向和距离一直复制下去，直到按ESC退出结束。

(要求类似li... [/B]

按空键相当于回车，程序就会结束。下面的程序以鼠标左键代替空键，按回车或空键或鼠标右键结束程序：
[PHP](defun c:ccf( / an dis p p1 p2 s sa ss)
  (setq ss (ssget) p t
        p1 (getpoint "\n起点：")
        p2 (getpoint "\n第二点:" p1)
        an (angle p1 p2) dis (distance p1 p2)
  )
  (setq s (entlast) sa (ssadd))
  (command "copy" ss "" p1 p2)
  (setq s (entnext s))
  (while s (ssadd s sa)(setq s (entnext s)))
  (while p
    (setq p (getpoint "\n鼠标左键继续：")
          p1 p2 p2 (polar p1 an dis)
          ss sa
    )
    (setq s (entlast) sa (ssadd))
    (if p
      (command "copy" ss "" p1 p2)
    )
   
    (setq s (entnext s))
    (while s (ssadd s sa)(setq s (entnext s)))
  )
  (princ)
)[/PHP]

xyp1964

连续复制

xyp1964

lxfz(连续复制)

linsw9606

谢谢你的程序,非常感谢,
试过了,鼠标左键还是比不上空键方便,用起来还是容易跟旧的复制混淆,
可否再做一点修改,还是用空键继续复制,Esc结束退出

001dwg

试试：
(while p
    (setq p (getpoint "\n鼠标左键继续：")
-----》
(while   (= (setq p (getstring "\n空格键继续：") ) "")

ljttjl

连续复制程序演示

xinr111

(defun C:CCC(/ xxx)
  (setq xxx (ssget))
  (command "copy" xxx "" "m")
)

这样不是更简单了.

gysjy

最初由 001dwg 发布
[B]试试：
(while p
    (setq p (getpoint "\n鼠标左键继续：")
-----》
(while   (= (setq p (getstring "\n空格键继续：") ) "") [/B]

这个方法很好。谢谢。

[PHP](defun c:ccf( / an dis p p1 p2 s sa ss)
  (setq ss (ssget) p ""
        p1 (getpoint "\n起点：")
        p2 (getpoint "\n第二点:" p1)
        an (angle p1 p2) dis (distance p1 p2)
  )
  (setq s (entlast) sa (ssadd))
  (command "copy" ss "" p1 p2)
  (setq s (entnext s))
  (while s (ssadd s sa)(setq s (entnext s)))
  (while (= p "" )
    (setq p (getstring "\n空格键继续：")
          p1 p2 p2 (polar p1 an dis)
          ss sa
    )
    (setq s (entlast) sa (ssadd))
    (if p
      (command "copy" ss "" p1 p2)
    )
     
    (setq s (entnext s))
    (while s (ssadd s sa)(setq s (entnext s)))
  )
  (princ)
)[/PHP]

linsw

我想要的就是这样的，
试过了很好用，很爽。

不就知为什么，之前的linsw9606户名上不来，现在找个linsw可以上来，
特地上来跟你说谢谢的。真的非常感谢.
好东西，希望推广大家用!!

hn-wqh

CAD2006以后版本具有连续复制功能

wangwei628

谢谢6楼的高手！

lmt112233

就是想要这样的，非常感谢.