基于两点的多重拷贝

Lisphk

1. (defun c:mcopy
   
2.   (/ mcopy_err AcDoc Space pt1 pt2 nb)
   
3.   (vl-load-com)
   
4. 
   
5.   (defun mcopy_err (msg)
   
6.     (if        (= msg "Function canceled")
   
7.       (princ)
   
8.       (princ (strcat "\ nError:" msg))
   
9.     )
   
10.     (vla-endUndoMark AcDoc)
    
11.     (setq *error*   m:err
    
12.               m:err nil
    
13.     )
    
14.     (princ)
    
15.   )
    
16. 
    
17.   (setq        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    
18.         Space (if (= (getvar "CVPORT") 1)
    
19.                 (vla-get-PaperSpace AcDoc)
    
20.                 (vla-get-ModelSpace AcDoc)
    
21.               )
    
22.   )
    
23.   (vla-StartUndoMark AcDoc)
    
24.   (if (and (= 1 (getvar "pickfirst"))
    
25.            (setq ss (cadr (ssgetfirst)))
    
26.       )
    
27.     (sssetfirst nil nil)
    
28.     (setq ss (ssget))
    
29.   )
    
30.   (initget 1)
    
31.   (setq pt1 (getpoint "\ nSpecify offset, first point:"))
    
32.   (initget 1)
    
33.   (setq pt2 (getpoint pt1 "\ nSecond point:"))
    
34.   (initget 1)
    
35.   (setq nb (getint "\ nNumber of elements:"))
    
36.   (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    
37.     (setq obj (vlax-ename-> vla-object obj))
    
38.     (repeat (1- nb)
    
39.       (vla-Copy obj)
    
40.       (vla-move        obj
    
41.                 (vlax-3d-point (trans pt1 1 0))
    
42.                 (vlax-3d-point (trans pt2 1 0))
    
43.       )
    
44.     )
    
45.   )
    
46.   (vla-endUndoMark AcDoc)
    
47.   (setq        *error*  m:err
    
48.             m:err nil
    
49.   )
    
50.   (princ)
    
51. )
    

(defun c:mcopy<br />   (/ mcopy_err AcDoc Space pt1 pt2 nb)<br />   (vl-load-com)<br /> <br />   (defun mcopy_err (msg)<br />     (if        (= msg "Function canceled")<br />       (princ)<br />       (princ (strcat "\ nError:" msg))<br />     )<br />     (vla-endUndoMark AcDoc)<br />     (setq *error*   m:err<br />               m:err nil<br />     )<br />     (princ)<br />   )<br /> <br />   (setq        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))<br />         Space (if (= (getvar "CVPORT") 1)<br />                 (vla-get-PaperSpace AcDoc)<br />                 (vla-get-ModelSpace AcDoc)<br />               )<br />   )<br />   (vla-StartUndoMark AcDoc)<br />   (if (and (= 1 (getvar "pickfirst"))<br />            (setq ss (cadr (ssgetfirst)))<br />       )<br />     (sssetfirst nil nil)<br />     (setq ss (ssget))<br />   )<br />   (initget 1)<br />   (setq pt1 (getpoint "\ nSpecify offset, first point:"))<br />   (initget 1)<br />   (setq pt2 (getpoint pt1 "\ nSecond point:"))<br />   (initget 1)<br />   (setq nb (getint "\ nNumber of elements:"))<br />   (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))<br />     (setq obj (vlax-ename-> vla-object obj))<br />     (repeat (1- nb)<br />       (vla-Copy obj)<br />       (vla-move        obj<br />                 (vlax-3d-point (trans pt1 1 0))<br />                 (vlax-3d-point (trans pt2 1 0))<br />       )<br />     )<br />   )<br />   (vla-endUndoMark AcDoc)<br />   (setq        *error*  m:err<br />             m:err nil<br />   )<br />   (princ)<br /> )<br />

ynhh

谢谢
请教有没有倾斜阵列的