lisp动态拖动源码(师兄)

lisp中实现动态拖动的源码,有奖没有

(princ "
师兄 QQ 361865648 拖动程序Vlisp版,命令名: VSX")
(vl-load-com)
(defun gen(a)
(princ "
选择要拖动的对象. ")
(setq ss(ssget))
(if (not ss)(VL-EXIT-WITH-VALUE 0))
(setq basp(getpoint "
选择拖动基点:"))
(if (not basp)(VL-EXIT-WITH-VALUE 0))
(setq i 0)
(princ "
指定目的点:")
(while(and (setq dpt(grread t 8 2))
(= (car dpt) 5))
(setq endp(cadr dpt))
(repeat (sslength ss)
(setq vn(vlax-ename->vla-object (ssname ss i)))
(vla-move vn (vlax-3d-point basp) (vlax-3d-point endp))
(setq i (+ 1 i))
)
(setq basp endp)
(setq i 0)
)
)
(defun c:vsx(/ errmsg)
(setq errmsg(vl-catch-all-apply ’gen (list 1)))
(princ)
)