多个截面独立求差集

gaics

这个标题不知道有没有歧义就是将如下图中的几个多段线构成的截面生成面域，并分别求差集。
实在找不到现成的程序就自己写了一个，请大家指正。看见Gu_xl版说用面域求并集来判断两个面域的关系，道理明白但是不知后面该怎么处理，所以就用最小包围框来判断了。

现在有个问题，如果选择的目标对象包括“圆、椭圆、多段线、面域”，但是圆和椭圆的组码不包含(70 . 1)，如何排除不闭合的多段线？

1. (defun c:tt()
   
2.   (command "undo" "be")
   
3.   (setq ss(ssget'((0 . "LWPOLYLINE,REGION")(70 . 1))))
   
4.   (makereg ss)
   
5.   (command "undo" "e")
   
6.   (princ)
   
7. )
   
8. 
   
9. (defun makereg(ss / i sslst ent minpt maxpt ii a b subss ssb)
   
10.   (setq i 0)
    
11.   (setq sslst'())
    
12.   (repeat(sslength ss)
    
13.     (setq ent(ssname ss i))
    
14.     (if (/= (mydxf ent 0) "REGION")
    
15.       (progn
    
16.   (command "region" ent "")
    
17.   (setq ent(entlast))
    
18.       )
    
19.     )
    
20.     (setq obj(vlax-ename->vla-object ent))
    
21.     (vla-getboundingbox obj 'minpt 'maxpt)
    
22.     (setq minpt (vlax-safearray->list minpt)
    
23.     maxpt (vlax-safearray->list maxpt))
    
24.     (setq sslst(cons (list (list(car minpt) (cadr minpt))
    
25.          (list(car maxpt) (cadr maxpt))
    
26.          ent)
    
27.          sslst))
    
28.     (setq i(+ i 1))
    
29.   )
    
30.   (setq i 0)
    
31.   (setq subss(ssadd))
    
32.   (repeat(length sslst)
    
33.     (setq a(nth i sslst))
    
34.     (setq ii 0)
    
35.     (setq ssb(ssadd))
    
36.     (while(and(< ii (length sslst))(entget(caddr a)))
    
37.       (setq b(nth ii sslst))
    
38.       (if(and(entget(caddr b))
    
39.        (< (car(car a)) (car(car b)))
    
40.        (< (cadr(car a)) (cadr(car b)))
    
41.        (> (car(cadr a)) (car(cadr b)))
    
42.        (> (cadr(cadr a)) (cadr(cadr b))))
    
43.   (setq ssb (ssadd(caddr b)ssb))
    
44.       )
    
45.       (setq ii(+ ii 1))
    
46.     )
    
47.     (if(and(/= ssb nil)(entget(caddr a)))
    
48.       (progn(command "subtract" (caddr a) "" ssb "")
    
49.   (setq subss(ssadd(caddr a)subss))
    
50.       )
    
51.       (if(entget(caddr a))(setq subss(ssadd(caddr a)subss)))
    
52.     )
    
53.     (setq i(+ i 1))
    
54.   )
    
55.   subss
    
56. )
    
57. 
    
58. (defun mydxf (ent i)
    
59.   (if (= (type ent) 'ename)
    
60.     (setq ent (entget ent))
    
61.   )
    
62.   (cdr (assoc i ent))
    
63. )

(defun c:tt()<br />   (command "undo" "be")<br />   (setq ss(ssget'((0 . "LWPOLYLINE,REGION")(70 . 1))))<br />   (makereg ss)<br />   (command "undo" "e")<br />   (princ)<br /> )<br /> <br /> (defun makereg(ss / i sslst ent minpt maxpt ii a b subss ssb)<br />   (setq i 0)<br />   (setq sslst'())<br />   (repeat(sslength ss)<br />     (setq ent(ssname ss i))<br />     (if (/= (mydxf ent 0) "REGION")<br />       (progn<br />   (command "region" ent "")<br />   (setq ent(entlast))<br />       )<br />     )<br />     (setq obj(vlax-ename->vla-object ent))<br />     (vla-getboundingbox obj 'minpt 'maxpt)<br />     (setq minpt (vlax-safearray->list minpt)<br />     maxpt (vlax-safearray->list maxpt))<br />     (setq sslst(cons (list (list(car minpt) (cadr minpt))<br />          (list(car maxpt) (cadr maxpt))<br />          ent)<br />          sslst))<br />     (setq i(+ i 1))<br />   )<br />   (setq i 0)<br />   (setq subss(ssadd))<br />   (repeat(length sslst)<br />     (setq a(nth i sslst))<br />     (setq ii 0)<br />     (setq ssb(ssadd))<br />     (while(and(< ii (length sslst))(entget(caddr a)))<br />       (setq b(nth ii sslst))<br />       (if(and(entget(caddr b))<br />        (< (car(car a)) (car(car b)))<br />        (< (cadr(car a)) (cadr(car b)))<br />        (> (car(cadr a)) (car(cadr b)))<br />        (> (cadr(cadr a)) (cadr(cadr b))))<br />   (setq ssb (ssadd(caddr b)ssb))<br />       )<br />       (setq ii(+ ii 1))<br />     )<br />     (if(and(/= ssb nil)(entget(caddr a)))<br />       (progn(command "subtract" (caddr a) "" ssb "")<br />   (setq subss(ssadd(caddr a)subss))<br />       )<br />       (if(entget(caddr a))(setq subss(ssadd(caddr a)subss)))<br />     )<br />     (setq i(+ i 1))<br />   )<br />   subss<br /> )<br /> <br /> (defun mydxf (ent i)<br />   (if (= (type ent) 'ename)<br />     (setq ent (entget ent))<br />   )<br />   (cdr (assoc i ent))<br /> )

gaics

没人帮俺看看吗？这个程序好像有问题

reyun

(setq ss(ssget '((-4 . "<or") (-4 . "<AND") (0 . "LWPOLYLINE,REGION") (70 . 1) (-4 . "AND>") (0 . "CIRCLE,ELLIPSE") (-4 . "or>"))))

gaics

reyun 发表于 2014-7-10 12:14
(setq ss(ssget '((-4 . ""))))

非常感谢！！