我需要一个跟CAD的复制一样的程序,区别是复制后新生的对象颜色都变为红色。
下面这段程序基本上可以实现,但是没有copy那样被复制的对象随着鼠标预显示出来,多重复制时需要回车等等缺陷。
好心的朋友帮我改改,或者简单的话推倒重来,谢谢先
- (defun c:cc (/ ss n pt1 ptn pt plist i j ssa enty lastent obj) (vl-load-com) (setq AcadObject (vlax-get-acad-object) AcadDocument (vla-get-ActiveDocument AcadObject) mSpace (vla-get-ModelSpace AcadDocument) ) (prompt "请选择要复制的对象") (setq ss (ssget)) (setq pt1 (getpoint "拾取基点")) (setq ptn (getpoint pt1 "拾取第二点")) (setq n 1) (while ptn (setq plist (append plist ptn)) (setq ptn (getpoint pt1 "拾取第二点")) (setq n (1+ n)) ) (setq i 0) (setq ssa (ssadd)) (while (< i (sslength ss)) (setq enty (ssname ss i)) (setq j 0) (repeat n (setq pt (list (nth j plist) (nth (+ 1 j) plist) (nth (+ 2 j) plist) ) j (+ 3 j) ) (command "copy" enty "" pt1 pt) (setq lastent (entlast)) (ssadd lastent ssa) (setq obj (vlax-ename->vla-object lastent)) (vla-put-color obj acRed) ) ;repeat (setq i (1+ i)) ) ;while)
|