【曲线】查找两条曲线最短距离并标记

marting

1. (defun c:xdtb_crvsmall (/ dist e1 e2 h p1 pmid pnt tbox txt v xdir)
   
2.   (defun _callback (dynpt)
   
3.     (redraw)
   
4.     (xdrx-grdraw 2 -1 pnt)
   
5.     (xdrx-grdraw 2 -1 (car pnt) 3 4)
   
6.     (xdrx-grdraw 2 -1 (cadr pnt) 3 4)
   
7.     (setq h (xd::doc:getpickboxheight))
   
8.     (xdrx-setpropertyvalue
   
9.       txt
   
10.       "textstring"
    
11.       (rtos (abs dist) 2 1)
    
12.       "textheight"
    
13.       h
    
14.     )
    
15.     (setq tbox (xdrx-getpropertyvalue txt "textbox")
    
16.           tbox (xd::pnts:close tbox)
    
17.           tbox (xdrx-points-offset (/ h 3.0) tbox)
    
18.           pmid (xd::geom:get9pt tbox 2)
    
19.           v    (xdrx-vector-normalize (mapcar '- (cadr tbox) (car tbox)))
    
20.     )
    
21.     (xdrx-entity-align
    
22.       txt
    
23.       pmid
    
24.       v
    
25.       (mapcar '+
    
26.               (xdrx-line-midp (car pnt) (cadr pnt))
    
27.               (xdrx-vector-product
    
28.                 (xdrx-vector-perpvector xdir)
    
29.                 (/ h 3.0)
    
30.               )
    
31.       )
    
32.       xdir
    
33.     )
    
34.     (xd::text:adjust txt)
    
35.     (setq tbox (xdrx-getpropertyvalue txt "textbox")
    
36.           tbox (xd::pnts:close tbox)
    
37.           tbox (xdrx-points-offset (/ h 3.0) tbox)
    
38.           tbox (xd::pnts:close tbox)
    
39.     )
    
40.     (xdrx-grdraw 8 -1 tbox)
    
41.     (xdrx-grdraw 2 1 txt)
    
42.   )
    
43.   (if (and (setq e1 (car (xdrx-entsel
    
44.                            "\n拾取第一条曲线<退出>:"
    
45.                            '((0 . "*line,arc,ellipse,circle"))
    
46.                          )
    
47.                     )
    
48.            )
    
49.            (setq e2 (car (xdrx-entsel
    
50.                            "\n拾取第一条曲线<退出>:"
    
51.                            '((0 . "*line,arc,ellipse,circle"))
    
52.                          )
    
53.                     )
    
54.            )
    
55.            (setq pnt (xdrx-getpropertyvalue e1 "getclosestpointto" e2))
    
56.       )
    
57.     (progn (xdrx-begin)
    
58.            (xdrx-sysvar-push '("osmode" 0 "dimzin" 0))
    
59.            (xdrx-pointmonitor "_callback")
    
60.            (setq txt (xdrx-text-make))
    
61.            (setq
    
62.              xdir (xdrx-vector-normalize (mapcar '- (cadr pnt) (car pnt)))
    
63.            )
    
64.            (if (< (car xdir) 0.0)
    
65.              (setq xdir (xdrx-vector-negate xdir))
    
66.            )
    
67.            (xdrx-setpropertyvalue
    
68.              txt
    
69.              "textstring"
    
70.              (rtos (setq dist (apply 'distance pnt)) 2 1)
    
71.            )
    
72.            (xdrx-document-zoomcenter
    
73.              (xdrx-line-midp (car pnt) (cadr pnt))
    
74.              (* 5 dist)
    
75.            )
    
76.            (xdrx-prompt "\n两条曲线最近点距离：" dist)
    
77.            (if (setq p1 (getpoint "\n>>左键绘制标记，回车退出查看:"))
    
78.              (progn (xdrx-sysvar-push '("pdmode" 35))
    
79.                     (xdrx-point-make pnt)
    
80.                     (xdrx-line-make pnt)
    
81.              )
    
82.            )           (redraw)
    
83.            (xdrx-pointmonitor)
    
84.            (xdrx-sysvar-pop)
    
85.            (xdrx-end)
    
86.     )
    
87.   )
    
88.   (princ)
    
89. )
    
90. 
    

(defun c:xdtb_crvsmall (/ dist e1 e2 h p1 pmid pnt tbox txt v xdir)<br />   (defun _callback (dynpt)<br />     (redraw)<br />     (xdrx-grdraw 2 -1 pnt)<br />     (xdrx-grdraw 2 -1 (car pnt) 3 4)<br />     (xdrx-grdraw 2 -1 (cadr pnt) 3 4)<br />     (setq h (xd::doc:getpickboxheight))<br />     (xdrx-setpropertyvalue<br />       txt<br />       "textstring"<br />       (rtos (abs dist) 2 1)<br />       "textheight"<br />       h<br />     )<br />     (setq tbox (xdrx-getpropertyvalue txt "textbox")<br />           tbox (xd::pnts:close tbox)<br />           tbox (xdrx-points-offset (/ h 3.0) tbox)<br />           pmid (xd::geom:get9pt tbox 2)<br />           v    (xdrx-vector-normalize (mapcar '- (cadr tbox) (car tbox)))<br />     )<br />     (xdrx-entity-align<br />       txt<br />       pmid<br />       v<br />       (mapcar '+<br />               (xdrx-line-midp (car pnt) (cadr pnt))<br />               (xdrx-vector-product<br />                 (xdrx-vector-perpvector xdir)<br />                 (/ h 3.0)<br />               )<br />       )<br />       xdir<br />     )<br />     (xd::text:adjust txt)<br />     (setq tbox (xdrx-getpropertyvalue txt "textbox")<br />           tbox (xd::pnts:close tbox)<br />           tbox (xdrx-points-offset (/ h 3.0) tbox)<br />           tbox (xd::pnts:close tbox)<br />     )<br />     (xdrx-grdraw 8 -1 tbox)<br />     (xdrx-grdraw 2 1 txt)<br />   )<br />   (if (and (setq e1 (car (xdrx-entsel<br />                            "\n拾取第一条曲线<退出>:"<br />                            '((0 . "*line,arc,ellipse,circle"))<br />                          )<br />                     )<br />            )<br />            (setq e2 (car (xdrx-entsel<br />                            "\n拾取第一条曲线<退出>:"<br />                            '((0 . "*line,arc,ellipse,circle"))<br />                          )<br />                     )<br />            )<br />            (setq pnt (xdrx-getpropertyvalue e1 "getclosestpointto" e2))<br />       )<br />     (progn (xdrx-begin)<br />            (xdrx-sysvar-push '("osmode" 0 "dimzin" 0))<br />            (xdrx-pointmonitor "_callback")<br />            (setq txt (xdrx-text-make))<br />            (setq<br />              xdir (xdrx-vector-normalize (mapcar '- (cadr pnt) (car pnt)))<br />            )<br />            (if (< (car xdir) 0.0)<br />              (setq xdir (xdrx-vector-negate xdir))<br />            )<br />            (xdrx-setpropertyvalue<br />              txt<br />              "textstring"<br />              (rtos (setq dist (apply 'distance pnt)) 2 1)<br />            )<br />            (xdrx-document-zoomcenter<br />              (xdrx-line-midp (car pnt) (cadr pnt))<br />              (* 5 dist)<br />            )<br />            (xdrx-prompt "\n两条曲线最近点距离：" dist)<br />            (if (setq p1 (getpoint "\n>>左键绘制标记，回车退出查看:"))<br />              (progn (xdrx-sysvar-push '("pdmode" 35))<br />                     (xdrx-point-make pnt)<br />                     (xdrx-line-make pnt)<br />              )<br />            )           (redraw)<br />            (xdrx-pointmonitor)<br />            (xdrx-sysvar-pop)<br />            (xdrx-end)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

kyky1002

非常强大的功能

1917732332

非常强大的功能

yuren008

做个对论坛有益的人。

既然青春留不住