求高手优化选定层连续复制
本帖最后由 吴琦 于 2016-4-10 11:50 编辑求高手帮小弟优化一下这个选定层连续复制程序，程序本身可用，但达不到CAD自带复制的视觉效果，不胜感激。(defun c:ccv (/ ss n ln ssl )
(princ "\n指定图层选定物体复制")
(princ "\n请选择目标层：")
(setq ssl (ssget))
(setq n 0)
(setq ln nil)
(repeat (sslength ssl)
(setq ln (append ln (list (cdr(assoc 8 (entget (ssname ssl n)))))))
(setq n (1+ n))
)
(princ "\n请框选要移动的图元：")
(setq ss (ssget (list (cons 8 (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) ln))))))
(setq p1 (getpoint))
(while
(setq p2 (getpoint))
(command "_.copy" ss "" p1 p2 "")
)
(princ)
) (defun c:tt (/ ssl n la lst ss p1)
(princ "\n指定图层选定物体复制")
(princ "\n请选择目标层: ")
(setq ssl (ssget)
n 0
)
(repeat (sslength ssl)
(setq la(cdr (assoc 8 (entget (ssname ssl n))))
lst (if (not (member la lst))
(cons la lst)
lst
)
n (1+ n)
)
)
(setq la (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) lst)))
(princ "\n请框选要移动的图元: ")
(setq ss (ssget (list (cons 8 la))))
(setq p1 (getpoint))
(command "_.copy" ss "" "M" p1 pause)
(princ)
) 选定图层（commond "copy" ""）
页:
[1]