很久没发贴了，发个动态复制，当作报到一下吧。
;=======================动态复制========================================(defun c:ccd ( / s1 p1 p2 di n1 n2 st gr tt ang s2 li txt doc err )
(setq s1 (ssget))
(setq s1 (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s1)))))
(setq p1 (getpoint "\n请选择基点:"))
(setq di (getdist p1 "\n请输入间距:"))
(setq doc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq err *error*)
(defun *error* (msg)
(foreach n2 li (vla-delete n2))
(setq *error* err)
(princ)
)
(command "undo" "be")
(setq tt t)
(while tt
(setq gr (grread t 4 2))
(cond
((= (car gr) 5)
(progn
(if li (foreach n2 li (vla-delete n2)))
(setq p2 (osnap (cadr gr) "_nea"))
(if (null p2) (setq p2 (cadr gr)))
(setq n1 1)
(setq ang (angle p1 p2))
(setq txt (vla-addtext doc (strcat "间距：" (itoa (fix (/ (distance p1 p2) di)))) (vlax-3d-point p2) 400))
(vla-put-color txt 6)
(setq li (list txt))
(repeat (fix (/ (distance p1 p2) di))
(foreach n2 s1
(progn
(setq s2 (vla-copy n2))
(vla-move s2 (vlax-3d-point (trans p1 1 0)) (vlax-3d-point (trans (polar p1 ang (* di n1)) 1 0)))
(setq li (append li (list s2)))
)
)
(setq n1 (1+ n1))
)
))
((= (car gr) 3) (vla-delete txt) (setq tt nil))
)
)
(command "undo" "e")
(princ)
)
1.因为是实时复制，对象大多的话会卡，如果确实需要多对象复制的话，建议做成块再复制。
2.这个脚本可以看成在世界坐标中，二维任意方向的单向陈列，里面没有加ucs转换。
3.因为是任意方向，所以没有进行坐标轴的锁定，可以自己做辅助线， 这个脚本可以捕捉邻近点。
4.我不会做动态演示，就这样吧。 cghdy 发表于 2022-2-8 15:42
过程中不能切换正交，唯一的小缺憾
正交的方向应该很容易找到可以当成辅助线的的吧，我用的时候基本不会有这方面的困扰。反而是非正交经常需要做辅助线。 mubin1979 发表于 2022-3-16 11:32
楼主，在cad2008中，选择对象后出现:
; 错误: no function definition: nil
在最前面加句(vl-load-com)试试，应该能行。 楼主，在cad2008中，选择对象后出现:
; 错误: no function definition: nil 好帖 好贴，谢谢分享！ 谢谢分享！{:1_1:} 谢谢分享，好贴！ 过程中不能切换正交，唯一的小缺憾 很强，谢谢分享 很强，谢谢分享 好贴，谢谢分享！
页:
[1]
2