API应用 封闭曲线内外修剪

st788796

1. (defun c:tt (/ _isout e key ss1 pts ptl)
   
2.   (defun _isout (e1 e / sp ep mp stf etf mtf)
   
3.     (mapcar 'set '(sp mp ep) (xdrx_curve_getpoint e1))
   
4.     (setq stf (equal sp (xdrx_curve_getclosestpoint e sp) 1e-3)
   
5.           etf (equal ep (xdrx_curve_getclosestpoint e ep) 1e-3)
   
6.           mtf (xdrx_point_isinside mp e)
   
7.     )
   
8.     (or        (or (not stf)
   
9.             (not etf)
   
10.         )
    
11.         (and (and stf etf (not mtf)))
    
12.     )
    
13.   )             
    
14.   (if (and (setq e (car        (xdrx_entsel
    
15.                           "\n选择封闭线: "
    
16.                           '((0 . "*LINE,CIRCE,ELLIPSE"))
    
17.                         )
    
18.                    )
    
19.            )
    
20.            (xdrx_curve_isclosed e)
    
21.            (setq pts (xdrx_getsamplept e))
    
22.            (setq ss (ssget "F" pts '((0 . "*line,circle,arc,ellipse"))))
    
23.            (setq key (xdrx_yesorno "内部修剪<N修剪外部>" "Y"))
    
24.       )
    
25.     (progn
    
26.       (xdrx_setmark)
    
27.       (ssdel e ss)
    
28.       (mapcar '(lambda (x / ptl pams)
    
29.                  (setq ptl  (xdrx_curve_getinters x e 0)
    
30.                        pams (mapcar '(lambda (a)
    
31.                                        (xdrx_curve_getparamatpoint x a)
    
32.                                      )
    
33.                                     ptl
    
34.                             )
    
35.                        pams (vl-sort pams '<)                                     
    
36.                  )
    
37.                  (apply 'xdrx_curve_getsplitcurves (cons x pams))
    
38.                )
    
39.               (xdrx_pickset->ents ss)
    
40.       )
    
41.       (setq ss1 (xdrx_pickset_union ss (xdrx_getss)))
    
42.       (if (zerop key)
    
43.         (mapcar        '(lambda (x)
    
44.                    (if (_isout x e) (xdrx_entity_delete x))
    
45.                  )
    
46.                 (xdrx_pickset->ents ss1)
    
47.         )
    
48.         (mapcar        '(lambda (x)
    
49.                    (if (not (_isout x e)) (xdrx_entity_delete x))
    
50.                  )
    
51.                 (xdrx_pickset->ents ss1)
    
52.         )
    
53.       )
    
54.     )
    
55.   )
    
56.   (princ)
    
57. )

(defun c:tt (/ _isout e key ss1 pts ptl)<br />   (defun _isout (e1 e / sp ep mp stf etf mtf)<br />     (mapcar 'set '(sp mp ep) (xdrx_curve_getpoint e1))<br />     (setq stf (equal sp (xdrx_curve_getclosestpoint e sp) 1e-3)<br />           etf (equal ep (xdrx_curve_getclosestpoint e ep) 1e-3)<br />           mtf (xdrx_point_isinside mp e)<br />     )<br />     (or        (or (not stf)<br />             (not etf)<br />         )<br />         (and (and stf etf (not mtf)))<br />     )<br />   )             <br />   (if (and (setq e (car        (xdrx_entsel<br />                           "\n选择封闭线: "<br />                           '((0 . "*LINE,CIRCE,ELLIPSE"))<br />                         )<br />                    )<br />            )<br />            (xdrx_curve_isclosed e)<br />            (setq pts (xdrx_getsamplept e))<br />            (setq ss (ssget "F" pts '((0 . "*line,circle,arc,ellipse"))))<br />            (setq key (xdrx_yesorno "内部修剪<N修剪外部>" "Y"))<br />       )<br />     (progn<br />       (xdrx_setmark)<br />       (ssdel e ss)<br />       (mapcar '(lambda (x / ptl pams)<br />                  (setq ptl  (xdrx_curve_getinters x e 0)<br />                        pams (mapcar '(lambda (a)<br />                                        (xdrx_curve_getparamatpoint x a)<br />                                      )<br />                                     ptl<br />                             )<br />                        pams (vl-sort pams '<)                                     <br />                  )<br />                  (apply 'xdrx_curve_getsplitcurves (cons x pams))<br />                )<br />               (xdrx_pickset->ents ss)<br />       )<br />       (setq ss1 (xdrx_pickset_union ss (xdrx_getss)))<br />       (if (zerop key)<br />         (mapcar        '(lambda (x)<br />                    (if (_isout x e) (xdrx_entity_delete x))<br />                  )<br />                 (xdrx_pickset->ents ss1)<br />         )<br />         (mapcar        '(lambda (x)<br />                    (if (not (_isout x e)) (xdrx_entity_delete x))<br />                  )<br />                 (xdrx_pickset->ents ss1)<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

kwok

支持一下.学习学习.

ShaoRui

支持一下.学习学习.

xiaoyaoge00

支持，学习了，现在使用看看