面域求差集

lilq_78

2. (defun c:mreg ()
   
3.   (vl-load-com)
   
4.   (setq  *Obj (vlax-get-acad-object)
   
5.   *Doc (vla-get-activeDocument *Obj)
   
6.   *MSp (vla-get-Modelspace *Doc)
   
7.   )
   
8.   (princ "\n选择生成面域的多段线: ")
   
9.   (setq plss (ssget))
   
10.   (setq  pli  0
    
11.   dei  0
    
12.   plcount  (sslength plss)
    
13.   objs  nil
    
14.   )
    
15.   (repeat plcount
    
16.     (setq ent (ssname plss pli))
    
17.     (setq object (vlax-ename->vla-object ent))
    
18.     (setq pb (vla-get-closed object))
    
19.     (if  (= pb :vlax-true)
    
20.       (setq objs (cons object objs))
    
21.     )
    
22.     (setq pli (1+ pli))
    
23.   )
    
24.   (setq  curves (vlax-make-safearray
    
25.      vlax-vbobject
    
26.      (eval '(cons 0 (1- plcount)))
    
27.          )
    
28.   )
    
29.   (vlax-safearray-fill curves objs)
    
30.   (setq regobjs (vla-addregion *Msp curves))
    
31.   (repeat plcount
    
32.     (setq obj (nth dei objs))
    
33.     (vla-delete obj)
    
34.     (setq dei (1+ dei))
    
35.   )
    
36.   (setq regobjs (vlax-safearray->list (vlax-variant-value regobjs)))
    
37.   (setq  regobjs
    
38.    (vl-sort
    
39.      regobjs
    
40.      '(lambda (s1 s2) (> (vla-get-area s1) (vla-get-area s2)))
    
41.    )
    
42.   )
    
43. 
    
44. )

(defun c:mreg ()<br />   (vl-load-com)<br />   (setq  *Obj (vlax-get-acad-object)<br />   *Doc (vla-get-activeDocument *Obj)<br />   *MSp (vla-get-Modelspace *Doc)<br />   )<br />   (princ "\n选择生成面域的多段线: ")<br />   (setq plss (ssget))<br />   (setq  pli  0<br />   dei  0<br />   plcount  (sslength plss)<br />   objs  nil<br />   )<br />   (repeat plcount<br />     (setq ent (ssname plss pli))<br />     (setq object (vlax-ename->vla-object ent))<br />     (setq pb (vla-get-closed object))<br />     (if  (= pb :vlax-true)<br />       (setq objs (cons object objs))<br />     )<br />     (setq pli (1+ pli))<br />   )<br />   (setq  curves (vlax-make-safearray<br />      vlax-vbobject<br />      (eval '(cons 0 (1- plcount)))<br />          )<br />   )<br />   (vlax-safearray-fill curves objs)<br />   (setq regobjs (vla-addregion *Msp curves))<br />   (repeat plcount<br />     (setq obj (nth dei objs))<br />     (vla-delete obj)<br />     (setq dei (1+ dei))<br />   )<br />   (setq regobjs (vlax-safearray->list (vlax-variant-value regobjs)))<br />   (setq  regobjs<br />    (vl-sort<br />      regobjs<br />      '(lambda (s1 s2) (> (vla-get-area s1) (vla-get-area s2)))<br />    )<br />   )<br /> <br /> )

求出了面域的集合regobjs，如何求差集？

mychenhan

这个有用，好好学习一下

nzl1116

(vla-boolean obj1 acSubtraction obj2)

lilq_78

谢谢！

logitechlike

(vla-Boolean Object Operation Object2)
3DSolid 或　Region 对象之间的布尔运算　(并集、交集、差集)
acUnion : 执行并集运算
acIntersection : 执行交集运算
acSubtraction:  执行差集运算

lilq_78

太感谢啦！

tanle2020

obj2如果有很多图元怎么办

lilq_78

2. (defun c:mreg (/ reg_ss s0 sss count i obj_ss reg_count obj_ss reg_i reg_j kword reg_obj reg_obj1 reg_obj_area reg_obj_area1 new_obj_area)
   
3.   (setq reg_ss (ssget))
   
4.   (setq s0 (ssadd))
   
5.   (setq sss (entlast))
   
6.   (command "region" reg_ss "")
   
7.   (while (setq sss (entnext sss))
   
8.     (if        (not (member (cdr (assoc 0 (entget sss)))
   
9.                      '("region")
   
10.              )
    
11.         )
    
12.       (ssadd sss s0)
    
13.     )
    
14.   )
    
15.   (setq        count  (sslength s0)
    
16.         i      0
    
17.         obj_ss nil
    
18.   )
    
19.   (while (> count i)
    
20.     (setq ent (ssname s0 i))
    
21.     (setq obj (vlax-ename->vla-object ent))
    
22.     (setq obj_ss (cons obj obj_ss))
    
23.     (setq i (1+ i))
    
24.   )
    
25. 
    
26.   (setq        reg_count (length obj_ss)
    
27.         reg_i          1
    
28.         reg_j          1
    
29.   )
    
30.   (setq        obj_ss
    
31.          (vl-sort
    
32.            obj_ss
    
33.            '(lambda (s1 s2)
    
34.               (> (vla-get-area s1)
    
35.                  (vla-get-area s2)
    
36.               )
    
37.             )
    
38.          )
    
39.   )
    
40.   (while (< reg_i reg_count)
    
41.     (setq reg_obj (nth (- reg_i 1) obj_ss))
    
42.     (setq reg_obj_area (vla-get-area reg_obj))
    
43.     (while (< reg_j reg_count)
    
44.       (setq reg_obj1 (nth reg_j obj_ss))
    
45.       (setq reg_obj_area1 (vla-get-area reg_obj1))
    
46.       (command "undo" "m")
    
47.       (vla-boolean reg_obj acunion reg_obj1)
    
48.       (setq new_obj_area (vla-get-area reg_obj))
    
49.       (command "undo" "b")
    
50.       (if (= new_obj_area reg_obj_area)
    
51.         (progn
    
52.           (vla-boolean reg_obj acSubtraction reg_obj1)
    
53.           (setq obj_ss (vl-remove reg_obj1 obj_ss))
    
54.           (setq        obj_ss
    
55.                  (vl-sort
    
56.                    obj_ss
    
57.                    '(lambda (s1 s2)
    
58.                       (> (vla-get-area s1)
    
59.                          (vla-get-area s2)
    
60.                       )
    
61.                     )
    
62.                  )
    
63.           )
    
64.           (setq        reg_count (length obj_ss)
    
65.                 reg_i          0
    
66.           )
    
67.           (setq reg_j reg_count)
    
68.         )
    
69.       )
    
70.       (setq reg_j (1+ reg_j))
    
71.     )
    
72.     (setq reg_i (1+ reg_i))
    
73.     (setq reg_j reg_i)
    
74.   )
    
75.   (setq
    
76.     kword (strcase
    
77.             (getstring "\n是否做成并集（Y/N）： <N>")
    
78.           )
    
79.   )
    
80.   (if (= kword nil)
    
81.     (setq kword "N")
    
82.   )
    
83.   (setq union_reg 1)
    
84.   (setq union_obj (nth 0 obj_ss))
    
85.   (if (= kword "Y")
    
86.     (progn
    
87.       (while (< union_reg reg_count)
    
88.         (setq union_obj1 (nth union_reg obj_ss))
    
89.         (vla-boolean union_obj acunion union_obj1)
    
90.         (setq union_reg (1+ union_reg))
    
91.       )
    
92.     )
    
93.   )
    
94. )
    

(defun c:mreg (/ reg_ss s0 sss count i obj_ss reg_count obj_ss reg_i reg_j kword reg_obj reg_obj1 reg_obj_area reg_obj_area1 new_obj_area)<br />   (setq reg_ss (ssget))<br />   (setq s0 (ssadd))<br />   (setq sss (entlast))<br />   (command "region" reg_ss "")<br />   (while (setq sss (entnext sss))<br />     (if        (not (member (cdr (assoc 0 (entget sss)))<br />                      '("region")<br />              )<br />         )<br />       (ssadd sss s0)<br />     )<br />   )<br />   (setq        count  (sslength s0)<br />         i      0<br />         obj_ss nil<br />   )<br />   (while (> count i)<br />     (setq ent (ssname s0 i))<br />     (setq obj (vlax-ename->vla-object ent))<br />     (setq obj_ss (cons obj obj_ss))<br />     (setq i (1+ i))<br />   )<br /> <br />   (setq        reg_count (length obj_ss)<br />         reg_i          1<br />         reg_j          1<br />   )<br />   (setq        obj_ss<br />          (vl-sort<br />            obj_ss<br />            '(lambda (s1 s2)<br />               (> (vla-get-area s1)<br />                  (vla-get-area s2)<br />               )<br />             )<br />          )<br />   )<br />   (while (< reg_i reg_count)<br />     (setq reg_obj (nth (- reg_i 1) obj_ss))<br />     (setq reg_obj_area (vla-get-area reg_obj))<br />     (while (< reg_j reg_count)<br />       (setq reg_obj1 (nth reg_j obj_ss))<br />       (setq reg_obj_area1 (vla-get-area reg_obj1))<br />       (command "undo" "m")<br />       (vla-boolean reg_obj acunion reg_obj1)<br />       (setq new_obj_area (vla-get-area reg_obj))<br />       (command "undo" "b")<br />       (if (= new_obj_area reg_obj_area)<br />         (progn<br />           (vla-boolean reg_obj acSubtraction reg_obj1)<br />           (setq obj_ss (vl-remove reg_obj1 obj_ss))<br />           (setq        obj_ss<br />                  (vl-sort<br />                    obj_ss<br />                    '(lambda (s1 s2)<br />                       (> (vla-get-area s1)<br />                          (vla-get-area s2)<br />                       )<br />                     )<br />                  )<br />           )<br />           (setq        reg_count (length obj_ss)<br />                 reg_i          0<br />           )<br />           (setq reg_j reg_count)<br />         )<br />       )<br />       (setq reg_j (1+ reg_j))<br />     )<br />     (setq reg_i (1+ reg_i))<br />     (setq reg_j reg_i)<br />   )<br />   (setq<br />     kword (strcase<br />             (getstring "\n是否做成并集（Y/N）： <N>")<br />           )<br />   )<br />   (if (= kword nil)<br />     (setq kword "N")<br />   )<br />   (setq union_reg 1)<br />   (setq union_obj (nth 0 obj_ss))<br />   (if (= kword "Y")<br />     (progn<br />       (while (< union_reg reg_count)<br />         (setq union_obj1 (nth union_reg obj_ss))<br />         (vla-boolean union_obj acunion union_obj1)<br />         (setq union_reg (1+ union_reg))<br />       )<br />     )<br />   )<br /> )<br />

这是我修改后的程序，与各位共享。

hehoubin

不能差集和交集

hehoubin

hehoubin

要做到样在功能就好了。