不使用SOLID命令实现实体的差集

Lisphk

1. (defun c:soustrac (/ *error* ss1 ss2 n lst)
   
2.   (vl-load-com)
   
3.   (or *acdoc*
   
4.       (setq *acdoc* (vla-get-activeDocument (vlax-get-acad-object)))
   
5.   )
   
6.   (defun *error* (msg)
   
7.     (and
   
8.       msg
   
9.       (/= msg "Fonction annulée")
   
10.       (princ (strcat "\nErreur: " msg))
    
11.     )
    
12.     (vla-EndUndoMark *acdoc*)
    
13.     (princ)
    
14.   )
    
15.   (princ
    
16.     "\nSelect the solids and regions to remove from .."
    
17.   )
    
18.   (if
    
19.     (setq ss1 (ssget '((0 . "REGION,3DSOLID"))))
    
20.      (if (and
    
21.            (princ
    
22.              "\nSelect the solids and regions to subtract .."
    
23.            )
    
24.            (setq ss2 (ssget '((0 . "REGION,3DSOLID"))))
    
25.          )
    
26.        (progn
    
27.          (vla-StartUndoMark *acdoc*)
    
28.          (repeat (setq n (sslength ss2))
    
29.            (setq
    
30.              lst
    
31.               (cons
    
32.                 (vlax-ename->vla-object (ssname ss2 (setq n (1- n))))
    
33.                 lst
    
34.               )
    
35.            )
    
36.          )
    
37.          (repeat (setq n (sslength ss1))
    
38.            (setq
    
39.              obj (vlax-ename->vla-object (ssname ss1 (setq n (1- n))))
    
40.            )
    
41.            (foreach o lst
    
42.              (and (= (vla-get-ObjectName obj) (vla-get-ObjectName o))
    
43.                   (vla-Boolean obj acSubtraction (vla-copy o))
    
44.              )
    
45.            )
    
46.          )
    
47.          (initget "Yes No")
    
48.          (if (= "Yes"
    
49.                 (getkword
    
50.                   "\nDelete subtracted objects [Yes / No] <N>:"
    
51.                 )
    
52.              )
    
53.            (mapcar 'vla-delete lst)
    
54.          )
    
55.          (*error* nil)
    
56.        )
    
57.      )
    
58.   )
    
59.   (princ)
    
60. )
    
61. 
    

(defun c:soustrac (/ *error* ss1 ss2 n lst)<br />   (vl-load-com)<br />   (or *acdoc*<br />       (setq *acdoc* (vla-get-activeDocument (vlax-get-acad-object)))<br />   )<br />   (defun *error* (msg)<br />     (and<br />       msg<br />       (/= msg "Fonction annulée")<br />       (princ (strcat "\nErreur: " msg))<br />     )<br />     (vla-EndUndoMark *acdoc*)<br />     (princ)<br />   )<br />   (princ<br />     "\nSelect the solids and regions to remove from .."<br />   )<br />   (if<br />     (setq ss1 (ssget '((0 . "REGION,3DSOLID"))))<br />      (if (and<br />            (princ<br />              "\nSelect the solids and regions to subtract .."<br />            )<br />            (setq ss2 (ssget '((0 . "REGION,3DSOLID"))))<br />          )<br />        (progn<br />          (vla-StartUndoMark *acdoc*)<br />          (repeat (setq n (sslength ss2))<br />            (setq<br />              lst<br />               (cons<br />                 (vlax-ename->vla-object (ssname ss2 (setq n (1- n))))<br />                 lst<br />               )<br />            )<br />          )<br />          (repeat (setq n (sslength ss1))<br />            (setq<br />              obj (vlax-ename->vla-object (ssname ss1 (setq n (1- n))))<br />            )<br />            (foreach o lst<br />              (and (= (vla-get-ObjectName obj) (vla-get-ObjectName o))<br />                   (vla-Boolean obj acSubtraction (vla-copy o))<br />              )<br />            )<br />          )<br />          (initget "Yes No")<br />          (if (= "Yes"<br />                 (getkword<br />                   "\nDelete subtracted objects [Yes / No] <N>:"<br />                 )<br />              )<br />            (mapcar 'vla-delete lst)<br />          )<br />          (*error* nil)<br />        )<br />      )<br />   )<br />   (princ)<br /> )<br /> <br />

434939575

这个厉害！！