填充区域覆盖的线全部删除（已解决）

numen1014

如图，填充区域覆盖了一些线，许多这样的图，能不能一次性把填充区域的边线（不是填充边线）及覆盖的线全部删除。

newer

求助最好发测试图，图里面拷贝两份，标注上前后的差异
从你这个图看，哪些是覆盖要删除的？

numen1014

2. (defun c:sccx(/ p1 p2 px sspline ssline i n px10 px11 plpts pts plptsn ssdelline)
   
3.   ;↓获取相应特征值的点表 内部函数**********************************************************
   
4. (defun massoc (lst key)
   
5.   (vl-remove-if '(lambda (x) (/= key (car x))) lst)
   
6. );↑获取点表内部函数*********************************************************
   
7. 
   
8.   ;;;↓判断点是否在线段上******************************************************
   
9. (defun nsk:IsPtOnLine (pt l1 l2 fz)
   
10. (and
    
11. (numberp fz)
    
12. (equal (distance l1 l2) (+ (distance l1 pt) (distance l2 pt)) fz)
    
13. )
    
14. )
    
15. ;;;↓判断点是否在线段上******************************************************
    
16.   
    
17. ;;;程序主体******************************************************************************************
    
18. (setq sspline        (ssget '((0 . "*POLYLINE")))
    
19.       ssline        (ssget '((0 . "line")))
    
20.       i                0
    
21.       ssdelline        (ssadd)
    
22. )
    
23. (while (< i (sslength sspline));;;①开始sspline循环
    
24.   (setq        plpts  (massoc (entget (ssname sspline i)) 10);;;获得第i个多段线的顶点坐标（含标识码10）
    
25.         plptsN 0  )
    
26.   (repeat (length plpts)                         ;;;↓②开始第i根多段线顶点循环。;;;(1)每结束一次循环，【reverse】将上次第一个坐标放到点表plpts的最后，每次都是取得后续连个点，
    
27.     (setq p1 (cdr (car plpts))                          ;;;(2)repeat的长度等于点数，是为了闭合多段线全部取到。(3)此处用【cdr】是为了去掉元素中的标识码 10。
    
28.           p2 (cdr (cadr plpts))   )     
    
29. 
    
30.     (setq n 0)       
    
31.     (repeat (sslength ssline)                                            ;;;↓③开始判断line线repeat。
    
32.       (setq px10 (cdr (assoc 10 (entget (ssname ssLine n))))
    
33.             px11 (cdr (assoc 11 (entget (ssname ssLine n))))
    
34.       )                                                                                  ;;;↓④开始第n根line线判断。
    
35.       (if (and (nsk:IsPtOnLine px10 p1 p2 1.0) ;;判断直线端点是否在线上（含共点）
    
36.                (nsk:IsPtOnLine px11 p1 p2 1.0) ;;判断直线另一端点是否在线上（含共点）
    
37.           )
    
38.         (ssadd (ssname ssline n) ssdelline)    ;;如共线加入选择集【ssdelline】。
    
39.       )                                                                           ;;;↑④结束第n根line线判断。
    
40.       (setq n (1+ n))
    
41.    )                                                                   ;;;↑③结束判断line线repeat。
    
42.     (setq plpts (reverse (cons (car plpts) (reverse (cdr plpts)))))      ;;;将多段线第一个顶点坐标移到最后。
    
43.   )
    
44.                                                  ;;;↑②结束第i根多段线顶点循环。
    
45.   (setq i (1+ i))
    
46. )
    
47. ;;结束while循环。
    
48. (print
    
49.   (strcat "共删除线段" (rtos (sslength ssdelline)) "根")
    
50. )
    
51. (command "._erase" ssdelline "")
    
52. (princ)
    
53. )  ;;结束defun。

(defun c:sccx(/ p1 p2 px sspline ssline i n px10 px11 plpts pts plptsn ssdelline)<br />   ;↓获取相应特征值的点表 内部函数**********************************************************<br /> (defun massoc (lst key)<br />   (vl-remove-if '(lambda (x) (/= key (car x))) lst)<br /> );↑获取点表内部函数*********************************************************<br /> <br />   ;;;↓判断点是否在线段上******************************************************<br /> (defun nsk:IsPtOnLine (pt l1 l2 fz)<br /> (and<br /> (numberp fz)<br /> (equal (distance l1 l2) (+ (distance l1 pt) (distance l2 pt)) fz)<br /> )<br /> )<br /> ;;;↓判断点是否在线段上******************************************************<br />   <br /> ;;;程序主体******************************************************************************************<br /> (setq sspline        (ssget '((0 . "*POLYLINE")))<br />       ssline        (ssget '((0 . "line")))<br />       i                0<br />       ssdelline        (ssadd)<br /> )<br /> (while (< i (sslength sspline));;;①开始sspline循环<br />   (setq        plpts  (massoc (entget (ssname sspline i)) 10);;;获得第i个多段线的顶点坐标（含标识码10）<br />         plptsN 0  )<br />   (repeat (length plpts)                         ;;;↓②开始第i根多段线顶点循环。;;;(1)每结束一次循环，【reverse】将上次第一个坐标放到点表plpts的最后，每次都是取得后续连个点，<br />     (setq p1 (cdr (car plpts))                          ;;;(2)repeat的长度等于点数，是为了闭合多段线全部取到。(3)此处用【cdr】是为了去掉元素中的标识码 10。 <br />           p2 (cdr (cadr plpts))   )     <br /> <br />     (setq n 0)        <br />     (repeat (sslength ssline)                                            ;;;↓③开始判断line线repeat。<br />       (setq px10 (cdr (assoc 10 (entget (ssname ssLine n))))<br />             px11 (cdr (assoc 11 (entget (ssname ssLine n))))<br />       )                                                                                  ;;;↓④开始第n根line线判断。<br />       (if (and (nsk:IsPtOnLine px10 p1 p2 1.0) ;;判断直线端点是否在线上（含共点）<br />                (nsk:IsPtOnLine px11 p1 p2 1.0) ;;判断直线另一端点是否在线上（含共点）<br />           )<br />         (ssadd (ssname ssline n) ssdelline)    ;;如共线加入选择集【ssdelline】。<br />       )                                                                           ;;;↑④结束第n根line线判断。<br />       (setq n (1+ n))<br />    )                                                                   ;;;↑③结束判断line线repeat。<br />     (setq plpts (reverse (cons (car plpts) (reverse (cdr plpts)))))      ;;;将多段线第一个顶点坐标移到最后。 <br />   )<br />                                                  ;;;↑②结束第i根多段线顶点循环。<br />   (setq i (1+ i))<br /> )<br /> ;;结束while循环。<br /> (print<br />   (strcat "共删除线段" (rtos (sslength ssdelline)) "根")<br /> )<br /> (command "._erase" ssdelline "")<br /> (princ)<br /> )  ;;结束defun。

numen1014

2. 　;判断点是否在线段上：
   
3. 
   
4. 　;　设点为Q，线段为P1P2 ，判断点Q在该线段上的依据是：( Q - P1 ) × ( P2 - P1 ) = 0 且 Q 在以 P1，P2为对角顶点的矩形内。前者保证Q点在直线P1P2上，后者是保证Q点不在线段P1P2的延长线或反向延长线上，对于这一步骤的判断可以用以下过程实现：
   
5. 
   
6. 　;　ON-SEGMENT(pi,pj,pk)
   
7. 　;　if min(xi,xj) <= xk <= max(xi,xj)
   
8.   ;      and min(yi,yj) <= yk <= max(yi,yj)
   
9. 　;　then return true;
   
10. 　;　else return false;
    
11. 
    
12. 　;　特别要注意的是，由于需要考虑水平线段和垂直线段两种特殊情况，min(xi,xj)<=xk<=max(xi,xj)和min(yi,yj)<=yk<=max(yi,yj)两个条件必须同时满足才能返回真值。
    
13. (defun c:tt(/ p1 p2 px sspline ssline i n px10 px11 plpts pts plptsn ssdelline ssbkline ptlst ptmin ptmax angsub angsub2 el1 nlin)
    
14. ;↓获取点表内部函数**********************************************************
    
15. (defun massoc (lst key)
    
16.   (vl-remove-if '(lambda (x) (/= key (car x))) lst)
    
17. )
    
18.   ;↑获取点表内部函数*********************************************************
    
19. 
    
20.   ;;;↓判断点是否在线段上******************************************************
    
21. (defun nsk:IsPtOnLine (px pt1 pt2 fz)
    
22.   (and
    
23.     (numberp fz)
    
24.     (equal (distance pt1 pt2)
    
25.            (+ (distance pt1 px) (distance pt2 px))
    
26.            fz
    
27.     )
    
28.   )
    
29. )
    
30. 
    
31. ;;↓判断点是否与线共线。***************************************************************************
    
32. ;;1  p1是否在p2 p3线上,返回0.0
    
33.     ;;p1 is a point;p2 and p3 are points that form a line segment;;returns  1 is p1 is on one side;;
    
34.                                                                          ;;-1 if on the other side
    
35.                                                                          ;; 0 if on the line
    
36.   (defun PT_side (p1 p2 p3 / a dx dx1 dy dy1)
    
37.     (setq dx  (- (car p3) (car p2))
    
38.           dy  (- (cadr p3) (cadr p2))
    
39.           dx1 (- (car p1) (car p2))
    
40.           dy1 (- (cadr p1) (cadr p2))
    
41.     )                                        ;setq
    
42.     (setq a (- (* dx dy1) (* dy dx1))
    
43.           a (rtos a 2 6)
    
44.           a (atof a)
    
45.     )                                        ;setq
    
46.     (if        (equal 0.0 a 0.5)
    
47.       (setq a 0.0)
    
48.     )                                        ;setq
    
49. 
    
50.     (print "判定结果是：")
    
51.     (print a)
    
52.     a
    
53. 
    
54.   )
    
55.   ;;;↑判断点是否与线共线。**************************************************************************
    
56. 
    
57. (defun 3pangle( p1 p2 px / p3-p1p2 p3-p2p1 YN);;;判断px是否与直线p1-p2共线。
    
58.                (setq px-p1p2 (- (angle p1 px) (angle p1 p2 ))
    
59.                      px-p2p1 (- (angle p2 px) (angle p2 p1)))
    
60.                (if (or (equal 0.0 px-p1p2 0.1)  (equal 0.0 px-p2p1 0.1))
    
61.                  (setq yn "Y")
    
62.                  (setq yn "N")
    
63.                  )
    
64.                 yn
    
65.   )
    
66. 
    
67. ;;;程序主体******************************************************************************************
    
68. (setq sspline (ssget  '((0 . "*POLYLINE")))
    
69.         ssline (ssget '((0 . "line")))
    
70.           i      0
    
71.           ssdelline (ssadd)
    
72.           ssbkline     0 )
    
73. (setvar "cmdecho" 0)
    
74.   
    
75.    (while  (< i (sslength sspline))                     ;;;①开始sspline循环
    
76.     (setq plpts (massoc (entget (ssname sspline i)) 10) ;;;获得第i个多段线的顶点坐标（含标识码10）
    
77.             plptsN 0
    
78.           )
    
79.     (repeat (length plpts)                              ;;;↓②开始第i根多段线顶点循环。
    
80.     (setq p1 (cdr (car plpts))                          ;;;(1)循环结束后，将第一个点的坐标放到表plpts的最后，每次都都是取得后续连个点，
    
81.           p2 (cdr (cadr plpts))                        ;;;(2)repeat的长度等于点数，是为了闭合多段线全部取到。
    
82.           p1 (reverse (cons 0.0 (reverse p1)))                                                 ;;;(3)此处用【cdr】是为了去掉元素中的标识码 10。
    
83.           p2 (reverse (cons 0.0 (reverse p2)))
    
84.           )
    
85.     ; (print p1)(print p2)
    
86. 
    
87.       (setq n 0) ;直线选择集起始值为0
    
88.            (repeat (sslength ssLine)                    ;;;↓③开始判断line线repeat。
    
89.              ;(print (strcat "第" (rtos n )"次循环"))
    
90.            (setq px10  (cdr (assoc 10 (entget (ssname ssLine n))))
    
91.                  px11  (cdr (assoc 11 (entget (ssname ssLine n))))            ; (mapcar '(lambda (pt)(list (car pt) (cadr pt))) 3dplist)
    
92.                 )
    
93.                 (setq ptlst (list px10 px11 p1 p2))
    
94.              (if (or (equal "Y" (3pangle p1 p2 px10))(equal "Y" (3pangle p1 p2 px11)))                        ;;;↓④开始第n根line线判断。
    
95.                (progn
    
96.                    (if (and (nsk:IsPtOnLine px10 P1 P2 1.0) (nsk:IsPtOnLine px11 P1 P2 1.0))
    
97.                      (ssadd (ssname ssline n) ssdelline)
    
98.                
    
99.                  (progn
    
100.                    (if (or (nsk:IsPtOnLine px10 P1 P2 1.0) (nsk:IsPtOnLine px11 P1 P2 1.0))
     
101.                       (progn
     
102.                              
     
103.                               (setq ptmin (list (apply 'min (mapcar 'car ptlst))(apply 'min (mapcar 'cadr ptlst)) '0.0))
     
104.                               (setq ptmax (list (apply 'max (mapcar 'car ptlst))(apply 'max (mapcar 'cadr ptlst)) '0.0))
     
105.                               (setq el1 (entget (ssname ssline n)))
     
106.                              
     
107.                            (cond
     
108.                               ((and (equal ptmax p2 1) (equal ptmin px10 1)) (setq el1 (subst (cons 11 p1)(assoc 11 el1) el1)))
     
109.                               ((and (equal ptmax p2 1) (equal ptmin px11 1)) (setq el1 (subst (cons 10 p1)(assoc 10 el1) el1)))
     
110.                               ((and (equal ptmax p1 1) (equal ptmin px10 1)) (setq el1 (subst (cons 11 p2)(assoc 11 el1) el1)))
     
111.                               ((and (equal ptmax p1 1) (equal ptmin px11 1)) (setq el1 (subst (cons 10 p2)(assoc 10 el1) el1)))
     
112.                               ((and (equal ptmin p2 1) (equal ptmax px10 1)) (setq el1 (subst (cons 11 p1)(assoc 11 el1) el1)))
     
113.                               ((and (equal ptmin p2 1) (equal ptmax px11 1)) (setq el1 (subst (cons 10 p1)(assoc 10 el1) el1)))
     
114.                               ((and (equal ptmin p1 1) (equal ptmax px10 1)) (setq el1 (subst (cons 11 p2)(assoc 11 el1) el1)))
     
115.                               ((and (equal ptmin p1 1) (equal ptmax px11 1)) (setq el1 (subst (cons 10 p2)(assoc 10 el1) el1)))
     
116.                            )
     
117.                           (entmod el1)
     
118.                         (setq ssbkline (1+ ssbkline))
     
119.                             )
     
120.                        )
     
121.                                )))
     
122.                             ;(command "BREAK" (ssname ssline n)  p1 p2)
     
123.                             ;(setq ssbkline (1+ ssbkline)))
     
124.                   
     
125.              );;;                                                                                   ↑④结束第n根line线判断。
     
126.              (setq n (1+ n)) ;;;控制③repeat循环不能动。
     
127.            )                                                    ;;;↑③结束判断line线repeat。
     
128.       (setq plpts (reverse (cons (car plpts ) (reverse (cdr plpts)))))
     
129.       )                                                                 ;;↑②结束第i根多段线顶点循环。
     
130.       
     
131.        (setq i (1+ i))
     
132.      )  ;;结束while循环。
     
133.         (if (/= 0 (sslength ssdelline))
     
134.         (progn
     
135.       (print (strcat "***共删除"(rtos (sslength ssdelline)) "根线。***")) (command "._erase" ssdelline ""))
     
136.       (print (strcat "***共删除0根线***")))
     
137.       (print (strcat "***共截断"(rtos ssbkline) "根线。***"))   
     
138.       (setq ssdelline nil)
     
139.       (setvar "cmdecho"   1)
     
140.       (princ)
     
141.      )  ;;结束defun。
     
142. 
     
143. 
     
144. ;;;*******************************************************************************************************************
     
145. 
     
146. 
     
147. 
     

　;判断点是否在线段上：<br /> <br /> 　;　设点为Q，线段为P1P2 ，判断点Q在该线段上的依据是：( Q - P1 ) × ( P2 - P1 ) = 0 且 Q 在以 P1，P2为对角顶点的矩形内。前者保证Q点在直线P1P2上，后者是保证Q点不在线段P1P2的延长线或反向延长线上，对于这一步骤的判断可以用以下过程实现：<br /> <br /> 　;　ON-SEGMENT(pi,pj,pk)<br /> 　;　if min(xi,xj) <= xk <= max(xi,xj)<br />   ;      and min(yi,yj) <= yk <= max(yi,yj)<br /> 　;　then return true;<br /> 　;　else return false;<br /> <br /> 　;　特别要注意的是，由于需要考虑水平线段和垂直线段两种特殊情况，min(xi,xj)<=xk<=max(xi,xj)和min(yi,yj)<=yk<=max(yi,yj)两个条件必须同时满足才能返回真值。<br /> (defun c:tt(/ p1 p2 px sspline ssline i n px10 px11 plpts pts plptsn ssdelline ssbkline ptlst ptmin ptmax angsub angsub2 el1 nlin)<br /> ;↓获取点表内部函数**********************************************************<br /> (defun massoc (lst key)<br />   (vl-remove-if '(lambda (x) (/= key (car x))) lst)<br /> )<br />   ;↑获取点表内部函数*********************************************************<br /> <br />   ;;;↓判断点是否在线段上******************************************************<br /> (defun nsk:IsPtOnLine (px pt1 pt2 fz)<br />   (and<br />     (numberp fz)<br />     (equal (distance pt1 pt2)<br />            (+ (distance pt1 px) (distance pt2 px))<br />            fz<br />     )<br />   )<br /> )<br /> <br /> ;;↓判断点是否与线共线。***************************************************************************<br /> ;;1  p1是否在p2 p3线上,返回0.0<br />     ;;p1 is a point;p2 and p3 are points that form a line segment;;returns  1 is p1 is on one side;;<br />                                                                          ;;-1 if on the other side<br />                                                                          ;; 0 if on the line<br />   (defun PT_side (p1 p2 p3 / a dx dx1 dy dy1)<br />     (setq dx  (- (car p3) (car p2))<br />           dy  (- (cadr p3) (cadr p2))<br />           dx1 (- (car p1) (car p2))<br />           dy1 (- (cadr p1) (cadr p2))<br />     )                                        ;setq<br />     (setq a (- (* dx dy1) (* dy dx1))<br />           a (rtos a 2 6)<br />           a (atof a)<br />     )                                        ;setq<br />     (if        (equal 0.0 a 0.5)<br />       (setq a 0.0)<br />     )                                        ;setq<br /> <br />     (print "判定结果是：")<br />     (print a)<br />     a<br /> <br />   )<br />   ;;;↑判断点是否与线共线。**************************************************************************<br /> <br /> (defun 3pangle( p1 p2 px / p3-p1p2 p3-p2p1 YN);;;判断px是否与直线p1-p2共线。<br />                (setq px-p1p2 (- (angle p1 px) (angle p1 p2 ))<br />                      px-p2p1 (- (angle p2 px) (angle p2 p1)))<br />                (if (or (equal 0.0 px-p1p2 0.1)  (equal 0.0 px-p2p1 0.1))<br />                  (setq yn "Y")<br />                  (setq yn "N")<br />                  )<br />                 yn<br />   )<br /> <br /> ;;;程序主体******************************************************************************************<br /> (setq sspline (ssget  '((0 . "*POLYLINE")))<br />         ssline (ssget '((0 . "line")))<br />           i      0<br />           ssdelline (ssadd)<br />           ssbkline     0 )<br /> (setvar "cmdecho" 0)<br />   <br />    (while  (< i (sslength sspline))                     ;;;①开始sspline循环<br />     (setq plpts (massoc (entget (ssname sspline i)) 10) ;;;获得第i个多段线的顶点坐标（含标识码10）<br />             plptsN 0<br />           )<br />     (repeat (length plpts)                              ;;;↓②开始第i根多段线顶点循环。<br />     (setq p1 (cdr (car plpts))                          ;;;(1)循环结束后，将第一个点的坐标放到表plpts的最后，每次都都是取得后续连个点，<br />           p2 (cdr (cadr plpts))                        ;;;(2)repeat的长度等于点数，是为了闭合多段线全部取到。<br />           p1 (reverse (cons 0.0 (reverse p1)))                                                 ;;;(3)此处用【cdr】是为了去掉元素中的标识码 10。<br />           p2 (reverse (cons 0.0 (reverse p2)))<br />           )<br />     ; (print p1)(print p2)<br /> <br />       (setq n 0) ;直线选择集起始值为0<br />            (repeat (sslength ssLine)                    ;;;↓③开始判断line线repeat。<br />              ;(print (strcat "第" (rtos n )"次循环"))<br />            (setq px10  (cdr (assoc 10 (entget (ssname ssLine n))))<br />                  px11  (cdr (assoc 11 (entget (ssname ssLine n))))            ; (mapcar '(lambda (pt)(list (car pt) (cadr pt))) 3dplist)<br />                 )<br />                 (setq ptlst (list px10 px11 p1 p2))<br />              (if (or (equal "Y" (3pangle p1 p2 px10))(equal "Y" (3pangle p1 p2 px11)))                        ;;;↓④开始第n根line线判断。<br />                (progn<br />                    (if (and (nsk:IsPtOnLine px10 P1 P2 1.0) (nsk:IsPtOnLine px11 P1 P2 1.0))<br />                      (ssadd (ssname ssline n) ssdelline)<br />                <br />                  (progn<br />                    (if (or (nsk:IsPtOnLine px10 P1 P2 1.0) (nsk:IsPtOnLine px11 P1 P2 1.0))<br />                       (progn<br />                              <br />                               (setq ptmin (list (apply 'min (mapcar 'car ptlst))(apply 'min (mapcar 'cadr ptlst)) '0.0))<br />                               (setq ptmax (list (apply 'max (mapcar 'car ptlst))(apply 'max (mapcar 'cadr ptlst)) '0.0))<br />                               (setq el1 (entget (ssname ssline n)))<br />                              <br />                            (cond<br />                               ((and (equal ptmax p2 1) (equal ptmin px10 1)) (setq el1 (subst (cons 11 p1)(assoc 11 el1) el1)))<br />                               ((and (equal ptmax p2 1) (equal ptmin px11 1)) (setq el1 (subst (cons 10 p1)(assoc 10 el1) el1)))<br />                               ((and (equal ptmax p1 1) (equal ptmin px10 1)) (setq el1 (subst (cons 11 p2)(assoc 11 el1) el1)))<br />                               ((and (equal ptmax p1 1) (equal ptmin px11 1)) (setq el1 (subst (cons 10 p2)(assoc 10 el1) el1)))<br />                               ((and (equal ptmin p2 1) (equal ptmax px10 1)) (setq el1 (subst (cons 11 p1)(assoc 11 el1) el1)))<br />                               ((and (equal ptmin p2 1) (equal ptmax px11 1)) (setq el1 (subst (cons 10 p1)(assoc 10 el1) el1)))<br />                               ((and (equal ptmin p1 1) (equal ptmax px10 1)) (setq el1 (subst (cons 11 p2)(assoc 11 el1) el1)))<br />                               ((and (equal ptmin p1 1) (equal ptmax px11 1)) (setq el1 (subst (cons 10 p2)(assoc 10 el1) el1)))<br />                            )<br />                           (entmod el1)<br />                         (setq ssbkline (1+ ssbkline))<br />                             )<br />                        )<br />                                )))<br />                             ;(command "BREAK" (ssname ssline n)  p1 p2)<br />                             ;(setq ssbkline (1+ ssbkline)))<br />                    <br />              );;;                                                                                   ↑④结束第n根line线判断。<br />              (setq n (1+ n)) ;;;控制③repeat循环不能动。<br />            )                                                    ;;;↑③结束判断line线repeat。<br />       (setq plpts (reverse (cons (car plpts ) (reverse (cdr plpts)))))<br />       )                                                                 ;;↑②结束第i根多段线顶点循环。<br />       <br />        (setq i (1+ i))<br />      )  ;;结束while循环。<br />         (if (/= 0 (sslength ssdelline))<br />         (progn <br />       (print (strcat "***共删除"(rtos (sslength ssdelline)) "根线。***")) (command "._erase" ssdelline ""))<br />       (print (strcat "***共删除0根线***")))<br />       (print (strcat "***共截断"(rtos ssbkline) "根线。***"))    <br />       (setq ssdelline nil)<br />       (setvar "cmdecho"   1)<br />       (princ)<br />      )  ;;结束defun。<br /> <br /> <br /> ;;;*******************************************************************************************************************<br /> <br /> <br /> <br />

numen1014

已解决，代码在楼上。