求高手优化选定层连续复制

吴琦

求高手帮小弟优化一下这个选定层连续复制程序，程序本身可用，但达不到CAD自带复制的视觉效果，不胜感激。

2. (defun c:ccv (/ ss n ln ssl )
   
3. (princ "\n指定图层选定物体复制")
   
4. (princ "\n请选择目标层：")
   
5.    (setq ssl (ssget))
   
6.    (setq n 0)
   
7.    (setq ln nil)
   
8.    (repeat (sslength ssl)
   
9.    (setq ln (append ln (list (cdr(assoc 8 (entget (ssname ssl n)))))))
   
10.         (setq n (1+ n))
    
11.   )
    
12.   (princ "\n请框选要移动的图元：")
    
13.        (setq ss (ssget (list (cons 8 (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) ln))))))
    
14.        (setq p1 (getpoint))
    
15.        (while
    
16.    (setq p2 (getpoint))
    
17.          (command "_.copy" ss "" p1 p2 "")
    
18.    )
    
19.    
    
20.   (princ)
    
21. )

(defun c:ccv (/ ss n ln ssl )<br /> (princ "\n指定图层选定物体复制")<br /> (princ "\n请选择目标层：")<br />    (setq ssl (ssget))<br />    (setq n 0)<br />    (setq ln nil)<br />    (repeat (sslength ssl)<br />    (setq ln (append ln (list (cdr(assoc 8 (entget (ssname ssl n)))))))<br />         (setq n (1+ n))<br />   )<br />   (princ "\n请框选要移动的图元：")<br />        (setq ss (ssget (list (cons 8 (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) ln))))))<br />        (setq p1 (getpoint))<br />        (while<br />    (setq p2 (getpoint))<br />          (command "_.copy" ss "" p1 p2 "")<br />    )<br />    <br />   (princ)<br /> )

xyp1964

2. (defun c:tt (/ ssl n la lst ss p1)
   
3.   (princ "\n指定图层选定物体复制")
   
4.   (princ "\n请选择目标层: ")
   
5.   (setq        ssl (ssget)
   
6.         n   0
   
7.   )
   
8.   (repeat (sslength ssl)
   
9.     (setq la  (cdr (assoc 8 (entget (ssname ssl n))))
   
10.           lst (if (not (member la lst))
    
11.                 (cons la lst)
    
12.                 lst
    
13.               )
    
14.           n   (1+ n)
    
15.     )
    
16.   )
    
17.   (setq la (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) lst)))
    
18.   (princ "\n请框选要移动的图元: ")
    
19.   (setq ss (ssget (list (cons 8 la))))
    
20.   (setq p1 (getpoint))
    
21.   (command "_.copy" ss "" "M" p1 pause)
    
22.   (princ)
    
23. )

(defun c:tt (/ ssl n la lst ss p1)<br />   (princ "\n指定图层选定物体复制")<br />   (princ "\n请选择目标层: ")<br />   (setq        ssl (ssget)<br />         n   0<br />   )<br />   (repeat (sslength ssl)<br />     (setq la  (cdr (assoc 8 (entget (ssname ssl n))))<br />           lst (if (not (member la lst))<br />                 (cons la lst)<br />                 lst<br />               )<br />           n   (1+ n)<br />     )<br />   )<br />   (setq la (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) lst)))<br />   (princ "\n请框选要移动的图元: ")<br />   (setq ss (ssget (list (cons 8 la))))<br />   (setq p1 (getpoint))<br />   (command "_.copy" ss "" "M" p1 pause)<br />   (princ)<br /> )

柴月二号

选定图层（commond "copy" ""）