(MBWP)打断于多边形（欢迎大佬们多给建议和意见）

fangmin723

1. ;;说明:打断于多边形  by-忘霄 2021.4.20
   
2. (defun C:MBWP(/ bf-list-split-3d breakapt edta ename ent eptlst getptlst interwithpt ss startbreak);c:MyBreakWithPolygon
   
3.   (defun breakapt(ent elst iptlst / ilst)
   
4.     (foreach e elst
   
5.       (if (setq ilst (InterWithPt ent e))
   
6.         (foreach p ilst
   
7.           (if (not (member p iptlst))
   
8.             (progn
   
9.               (command "_.BREAK" e "_non" (trans p 0 1) "_non" (trans p 0 1))
   
10.               ;(command "_.BREAK" e p "@")
    
11.               (breakapt
    
12.                 ent
    
13.                 (if (and (= 1 (length (setq ips (InterWithPt ent e)))) (equal (car ips) p 1e-8))
    
14.                   (vl-remove e (cons (entlast) elst))
    
15.                   (if (and (= 1 (length (setq ips (InterWithPt ent (entlast))))) (equal (car ips) p 1e-8))
    
16.                     elst
    
17.                     (cons (entlast) elst)
    
18.                   )
    
19.                 )
    
20.                 (cons p iptlst)
    
21.               )
    
22.             )
    
23.           )
    
24.         )
    
25.       )
    
26.     )
    
27.   )
    
28.   (defun InterWithPt(ent1 ent2 / bf-list-split-3d var)
    
29.     (defun BF-list-split-3d (lst)
    
30.       (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (BF-list-split-3d (cdddr lst))))
    
31.     )
    
32.     (if (> (vlax-safearray-get-u-bound (setq var (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object ent1) (vlax-ename->vla-object ent2) acExtendNone))) 1) 1)
    
33.       (BF-list-split-3d (vlax-safearray->list var))
    
34.       nil
    
35.     )
    
36.   )
    
37.   (defun getptlst(e) (mapcar 'cdr (vl-remove-if-not (function (lambda(x) (= 10 (car x)))) (entget e))))
    
38.   (defun BF-list-split-3d (lst)
    
39.     (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (BF-list-split-3d (cdddr lst))))
    
40.   )
    
41.   (defun startbreak(ent ss / ient inlst n)
    
42.     (setq n -1)
    
43.     (while (setq ient (ssname ss (setq n (1+ n))))
    
44.       (if (setq inlst (InterWithPt ent ient))
    
45.         (breakapt ent (list ient) '())
    
46.       )
    
47.     )
    
48.   )
    
49.   (command "_.UNDO" "be")
    
50.   (if (setq ent (car (entsel "\n请选择【直线】或者【由多段线构成的多边形】：")))
    
51.     (progn
    
52.       (setq ename (cdr (assoc 0 (setq edta (entget ent)))))
    
53.       (cond
    
54.         ((equal ename "LINE")
    
55.           (setq ss (ssdel ent (ssget "F" (list (cdr (assoc 10 edta)) (cdr (assoc 11 edta))))))
    
56.           (startbreak ent ss)
    
57.         )
    
58.         ((equal ename "LWPOLYLINE")
    
59.           (if (<= (length (setq eptlst (getptlst ent))) 2)
    
60.             (setq ss (ssdel ent (ssget "F" eptlst)))
    
61.             (setq ss (ssdel ent (ssget "CP" (append (setq eptlst (getptlst ent)) (list (car eptlst))))))
    
62.           )
    
63.           (startbreak ent ss)
    
64.         )
    
65.       )
    
66.     )
    
67.   )
    
68.   (command "_.UNDO" "e")
    
69.   (prin1)
    
70. )

;;说明:打断于多边形  by-忘霄 2021.4.20<br /> (defun C:MBWP(/ bf-list-split-3d breakapt edta ename ent eptlst getptlst interwithpt ss startbreak);c:MyBreakWithPolygon<br />   (defun breakapt(ent elst iptlst / ilst)<br />     (foreach e elst <br />       (if (setq ilst (InterWithPt ent e))<br />         (foreach p ilst<br />           (if (not (member p iptlst))<br />             (progn<br />               (command "_.BREAK" e "_non" (trans p 0 1) "_non" (trans p 0 1))<br />               ;(command "_.BREAK" e p "@")<br />               (breakapt<br />                 ent <br />                 (if (and (= 1 (length (setq ips (InterWithPt ent e)))) (equal (car ips) p 1e-8))<br />                   (vl-remove e (cons (entlast) elst))<br />                   (if (and (= 1 (length (setq ips (InterWithPt ent (entlast))))) (equal (car ips) p 1e-8))<br />                     elst<br />                     (cons (entlast) elst)<br />                   )<br />                 )<br />                 (cons p iptlst)<br />               )<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (defun InterWithPt(ent1 ent2 / bf-list-split-3d var)<br />     (defun BF-list-split-3d (lst)<br />       (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (BF-list-split-3d (cdddr lst))))<br />     )<br />     (if (> (vlax-safearray-get-u-bound (setq var (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object ent1) (vlax-ename->vla-object ent2) acExtendNone))) 1) 1)<br />       (BF-list-split-3d (vlax-safearray->list var))<br />       nil<br />     )<br />   )<br />   (defun getptlst(e) (mapcar 'cdr (vl-remove-if-not (function (lambda(x) (= 10 (car x)))) (entget e))))<br />   (defun BF-list-split-3d (lst)<br />     (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (BF-list-split-3d (cdddr lst))))<br />   )<br />   (defun startbreak(ent ss / ient inlst n)<br />     (setq n -1)<br />     (while (setq ient (ssname ss (setq n (1+ n))))<br />       (if (setq inlst (InterWithPt ent ient))<br />         (breakapt ent (list ient) '())<br />       )<br />     )<br />   )<br />   (command "_.UNDO" "be")<br />   (if (setq ent (car (entsel "\n请选择【直线】或者【由多段线构成的多边形】：")))<br />     (progn<br />       (setq ename (cdr (assoc 0 (setq edta (entget ent)))))<br />       (cond <br />         ((equal ename "LINE")<br />           (setq ss (ssdel ent (ssget "F" (list (cdr (assoc 10 edta)) (cdr (assoc 11 edta))))))<br />           (startbreak ent ss)<br />         )<br />         ((equal ename "LWPOLYLINE")<br />           (if (<= (length (setq eptlst (getptlst ent))) 2)<br />             (setq ss (ssdel ent (ssget "F" eptlst)))<br />             (setq ss (ssdel ent (ssget "CP" (append (setq eptlst (getptlst ent)) (list (car eptlst))))))<br />           )<br />           (startbreak ent ss)<br />         )<br />       )<br />     )<br />   )<br />   (command "_.UNDO" "e")<br />   (prin1)<br /> )

meja

又不能生成面域，否则功能会十分强大

xj6019

感谢大佬的分享精神

fangmin723

meja 发表于 2021-4-22 02:54
又不能生成面域，否则功能会十分强大

生成面域论坛应该有，我记得G版写过一个