[分享]：动态复制程序

wkai · 发表于 2004-3-2 14:47:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

十分欣赏sketchup中的复制方式,现写了一个用于acad的动态复制程序,大家试试,挺好用的.

[PHP]
(defun zf_dynamic_copy  (/ p1 p2 s e cn)
;__________________
  (defun ttt (ss n / m)
(setq ee e
   ns (ssadd)
)
(while (setq ee (entnext ee))
   (setq ns (ssadd ee ns))
)
(command "erase" ns "")
(command "copy" ss "" "m" "non" p1)
(setq m 0)
(repeat (atoi n)
   (setq m (1+ m))
   (cond
((= "/" (substr n (strlen n)))
   (command
   "non"
   (mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n)))))
   p1
   p2
   )
   )
)
(t
   (command "non"
   (mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)
   )
)
   )
)
(command)
  )
;__________________
  (princ "\n动态复制程序__BY__WKAI__晓东CAD空间论坛")
  (princ "\n选择要复制的物体:")
  (setq s (ssget))
  (setq p1 (getpoint "\n复制的起点:"))
  (setq p2 (getpoint p1 "\n复制的终点:"))
  (setq e (entlast))
  (command "copy" s "" "non" p1 "non" p2)
  (while (/= 0 (atof(setq cn (getstring "\n份数(以 / 结束为等分):"))))
(ttt s cn)
  )
  (princ)
)
[/PHP]

coolzhb · 发表于 2004-3-2 17:17:13

最初由 wkai 发布
[B]十分欣赏sketchup中的复制方式,现写了一个用于acad的动态复制程序,大家试试,挺好用的.

[PHP]
(defun zf_dynamic_copy  (/ p1 p2 s e cn)
;__________________
  (defun ttt (ss n / m)
(setq ee e
   ... [/B]

我用了，有的意思！比array好用！

自由的鱼 · 发表于 2004-3-2 18:47:18

这是一个好程序~~谢谢！

xiaping · 发表于 2004-3-2 20:07:01

最初由 wkai 发布
[B]十分欣赏sketchup中的复制方式,现写了一个用于acad的动态复制程序,大家试试,挺好用的.

[PHP]
(defun zf_dynamic_copy  (/ p1 p2 s e cn)
;__________________
  (defun ttt (ss n / m)
(setq ee e
   ... [/B]

请教如何加载，调用？我加载以后没有调用成功。

coolzhb · 发表于 2004-3-2 20:41:52

最初由 xiaping 发布
[B][QUOTE]最初由 wkai 发布
[B]十分欣赏sketchup中的复制方式,现写了一个用于acad的动态复制程序,大家试试,挺好用的.

[PHP]
(defun zf_dynamic_copy (/ p1 p2 s e cn)
;__________________
(defun... [/B]

将defun后面加c:，输入命令即可！

2002zjp · 发表于 2004-3-2 20:48:45

r14 能用吗？

liuyj · 发表于 2004-3-2 20:55:59

r14能用，挺不错的

aeo · 发表于 2004-3-2 23:04:34

拷贝的时候看不见预演不习惯
就改了几个字

[php]
(defun zf_dynamic_copy (/ p1 p2 s e cn)
;__________________
(defun ttt (ss n / m)
(setq ee e
ns (ssadd)
)
(while (setq ee (entnext ee))
(setq ns (ssadd ee ns))
)
(command "erase" ns "")
(command "copy" ss "" "m" "non" p1)
(setq m 0)
(repeat (atoi n)
(setq m (1+ m))
(cond
((= "/" (substr n (strlen n)))
(command
"non"
(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n)))))
p1
p2
)
)
)
(t
(command "non"
(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)
)
)
)
)
(command)
)
;__________________
(princ "\n动态复制程序__BY__WKAI__晓东CAD空间论坛")
(princ "\n选择要复制的物体:")
(setq s (ssget))
(setq p1 (getpoint "\n复制的起点:"))
(setvar"lastpoint" p1)
;(setq p2 (getpoint p1 "\n复制的终点:"))
(setq e (entlast))
(command "copy" s "" "non" p1 pause)
(if(not(equal p1(setq p2(getvar"lastpoint"))))
(while (/= 0 (atof(setq cn (getstring "\n份数(以 / 结束为等分):"))))
(ttt s cn)
)
)
(princ)
)[/php]

[php] 
(defun zf_dynamic_copy  (/ p1 p2 s e cn) 
 ;__________________ 
  (defun ttt (ss n / m) 
    (setq ee e 
      ns (ssadd) 
    ) 
    (while (setq ee (entnext ee)) 
      (setq ns (ssadd ee ns)) 
    ) 
    (command "erase" ns "") 
    (command "copy" ss "" "m" "non" p1) 
    (setq m 0) 
    (repeat (atoi n) 
      (setq m (1+ m)) 
      (cond 
    ((= "/" (substr n (strlen n))) 
     (command 
       "non" 
       (mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) 
           p1 
           p2 
       ) 
     ) 
    ) 
    (t 
     (command "non" 
          (mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2) 
     ) 
    ) 
      ) 
    ) 
    (command) 
  ) 
 ;__________________ 
  (princ "\n动态复制程序__BY__WKAI__晓东CAD空间论坛") 
  (princ "\n选择要复制的物体:") 
  (setq s (ssget)) 
  (setq p1 (getpoint "\n复制的起点:")) 
  (setvar"lastpoint" p1) 
  ;(setq p2 (getpoint p1 "\n复制的终点:")) 
  (setq e (entlast)) 
  (command "copy" s "" "non" p1 pause) 
  (if(not(equal p1(setq p2(getvar"lastpoint")))) 
  (while (/= 0 (atof(setq cn (getstring "\n份数(以 / 结束为等分):")))) 
    (ttt s cn) 
  ) 
  ) 
  (princ) 
)[/php]

(setq e (entlast))不完全对!!

我很早以前贴过一个offset的，方法简直一样
陌生人说的好，狗熊所见... ^_^

wkai · 发表于 2004-3-3 07:55:13

改得好，的确直观很多！

wcf · 发表于 2004-3-3 09:03:47

不错，能加上动态旋转复制就更好了。

wkai · 发表于 2004-3-3 09:24:52

更加灵活的版本：
[PHP]
(defun zf_dynamic_copy (/ p1 p2 s e cn a1 d1 ns cnn)
;__________________
 (defun ttt (ss n / m)
(setq ee e
 ns (ssadd)
)
(while (setq ee (entnext ee))
 (setq ns (ssadd ee ns))
)
(command "erase" ns "")
(command "copy" ss "" "m" "non" p1)
(if (member (substr n (strlen n)) '("/" "*"))
 (progn
(setq m 0)
(repeat (atoi n)
 (setq m (1+ m))
 (cond
 ((= "/" (substr n (strlen n)))
 (command "non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1 p2))
 )
 ((= "*" (substr n (strlen n)))
 (command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))
 )
 )
)
 )
 (command "non" (setq p2 (polar p1 a1 (atof n))))
)
(command)
 )
;__________________
 (princ "\n动态复制程序__BY__WKAI__晓东CAD空间论坛")
 (princ "\n选择要复制的物体:")
 (setq s (ssget))
 (setq p1 (getpoint "\n复制的起点:"))
 (command "undo" "be" "line" p1 p1 "" )
 (setq e (entlast) )
 (command "copy" s "" "non" p1 pause)
 (setq p2 (getvar "lastpoint")
a1 (angle p1 p2)
d1 (distance p1 p2)
 )
 (setq cn "1*")
 (while cn
(ttt s cn)
(initget 128)
(princ "\n输入坐标=复制终点 输入数值=修改间距 ")
(princ "\n输入数值n并以 / 结束=间距内等分n次复制输入数值n并以 * 结束=按间距复制n次 ")
(setq cnn (getpoint "\n请按提示输入<退出>:"))
(if (= 'LIST (type cnn))
 (setq p2 cnn
 a1 (angle p1 p2)
 d1 (distance p1 p2)
 )
 (setq cn cnn)
)
 )
 (entdel e)
 (command "undo" "e")
 (princ)
)
[/PHP]

andyhua5240 · 发表于 2004-3-3 10:25:35

大侠们，能否整理一下，做个附件呀，我等看不懂呀！
谢谢！

wkai · 发表于 2004-3-3 10:46:38

最初由 andyhua5240 发布
[B]大侠们，能否整理一下，做个附件呀，我等看不懂呀！
谢谢！ [/B]

好的~
下面的包括动态复制和动态旋转两个程序
动态旋转启动命令 DR 动态旋转复制命令 DC

wcf · 发表于 2004-3-3 12:38:36

好程序，支持WKAI的努力和奉献！

andyhua5240 · 发表于 2004-3-3 16:33:56

谢谢WKAI，好东东值得收藏！

账号		自动登录	找回密码
密码			立即注册

[分享]：动态复制程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [分享]：动态复制程序

Re: [分享]：动态复制程序

Re: Re: [分享]：动态复制程序