【曲线】井字裁剪

marting

1. (defun c:xdtb_jtrim (/ p1 p2 ss tf ints ss1 ents1)
   
2.   (if (and (setq p1 (getpoint "\n窗口第一点<退出>:"))
   
3.            (setq p2 (xd::doc:getcorner p1 "\r矩形第二点<退出>:" 7 nil))
   
4.            (setq
   
5.              ss        (ssget "cp" (cadr p2) '((0 . "*line,arc,circle,ellipse")))
   
6.            )
   
7.       )
   
8.     (progn (xdrx-begin)
   
9.            (setq tf (xd::doc:safezoom ss))
   
10.            (setq ints (xdrx-get-inters ss))
    
11.            (setq ints (mapcar '(lambda (x)
    
12.                                  (if (xdrx-point-isinside x (cadr p2))
    
13.                                    x
    
14.                                    nil
    
15.                                  )
    
16.                                )
    
17.                               ints
    
18.                       )
    
19.            )
    
20.            (setq ss1 (xdrx-curve-intersectbreak ss ints))
    
21.            (setq ents1 (xdrx-pickset->ents ss1))
    
22.            (mapcar '(lambda (x)
    
23.                       (if (= 0 (xd::curve:relation x (cadr p2)))
    
24.                         (xdrx-entity-delete x)
    
25.                       )
    
26.                     )
    
27.                    ents1
    
28.            )
    
29.            (xdrx-end)
    
30.     )
    
31.   )
    
32.   (princ)
    
33. )
    
34. 
    

(defun c:xdtb_jtrim (/ p1 p2 ss tf ints ss1 ents1)<br />   (if (and (setq p1 (getpoint "\n窗口第一点<退出>:"))<br />            (setq p2 (xd::doc:getcorner p1 "\r矩形第二点<退出>:" 7 nil))<br />            (setq<br />              ss        (ssget "cp" (cadr p2) '((0 . "*line,arc,circle,ellipse")))<br />            )<br />       )<br />     (progn (xdrx-begin)<br />            (setq tf (xd::doc:safezoom ss))<br />            (setq ints (xdrx-get-inters ss))<br />            (setq ints (mapcar '(lambda (x)<br />                                  (if (xdrx-point-isinside x (cadr p2))<br />                                    x<br />                                    nil<br />                                  )<br />                                )<br />                               ints<br />                       )<br />            )<br />            (setq ss1 (xdrx-curve-intersectbreak ss ints))<br />            (setq ents1 (xdrx-pickset->ents ss1))<br />            (mapcar '(lambda (x)<br />                       (if (= 0 (xd::curve:relation x (cadr p2)))<br />                         (xdrx-entity-delete x)<br />                       )<br />                     )<br />                    ents1<br />            )<br />            (xdrx-end)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

yuren008

做个对论坛有益的人。

LXH刚开始

很不错，但现在AUTOCAD 2021版TR的功能已经改善了不小。如果AUOTCAD没有升级版本的话这个还是很方便的。

tzfcn

很好的代码，有创意。

小小的人

找了好久 终于你发出来了  谢谢

liuwenxuan8351

感谢楼主分享 收藏了

wx_tPzOZHoY

窗口第一点<退出>:; 错误: no function definition: XD::DOC:GETCORNER    提示这个怎么回事？

小康_U8y3Y

这么好的东西  谢谢