[分享]：求曲线间最近距离及最近点的LISP程序

wkai

2004.01.09.11.45:通用的程序在5楼，可以求任意曲线间的最小距离。[/COLOR]

这个命题是 陌生人 在
http://www.xdcad.net/forum/showthread.php?s=&threadid=127606
中提出来的，我一直很感兴趣，今天上午监考时没有事情，就尝试解决这个问题。

下面就是刚刚写出来的求共面曲线间最近距离及最近点的LISP程序，可以应用于求直线段，圆弧，圆，复义线（包括spline化过的，较慢）之间。对于spline和ellipse，可以先将它们用复义线模拟出来，再求其之间的距离。

请各位大侠提提意见~

2. 
   
3.   [FONT=courier new]
   
4. ;_求共面曲线间最近距离及最近点的LISP程序__BY__WKAI__晓东CAD论坛______________
   
5. ;_2004.01.05.16.02___________________________________________________________
   
6. ;____________________________________________________________________________
   
7. ;____________________________________________________________________________
   
8. (defun c:tt (/ ent1 ent2 n1 n2 dist)
   
9.   (princ "\n请选择共面的线段、圆、圆弧，或者复义线，第一段:")
   
10.   (setq vlobject1 (vlax-ename->vla-object (setq ent1 (car (entsel)))))
    
11.   (princ "\n请选择共面的线段、圆、圆弧，或者复义线，第二段:")
    
12.   (setq vlobject2 (vlax-ename->vla-object (setq ent2 (car (entsel)))))
    
13.   (setq int (vlax-variant-value (vla-intersectwith vlobject1 vlobject2 acextendnone)))
    
14.   (if (> (vlax-safearray-get-u-bound int 1) 0)
    
15.     (princ "\n最小距离为：0")
    
16.     (progn
    
17.       (setq s1 (is_pl ent1 vlobject1))
    
18.       (setq s2 (is_pl ent2 vlobject2))
    
19.       (setq n1 0
    
20.             n2 0
    
21.       )
    
22.       (repeat (sslength s1)
    
23.         (setq ent1 (ssname s1 n1)
    
24.               n1   (1+ n1)
    
25.               n2   0
    
26.         )
    
27.         (repeat        (sslength s2)
    
28.           (setq        ent2 (ssname s2 n2)
    
29.                 n2   (1+ n2)
    
30.           )
    
31.           (setq dist (append dist (list (distance_between_ents ent1 ent2))))
    
32.         )
    
33.       )
    
34.       (setq dist (car (vl-sort dist (function (lambda (e1 e2) (< (car e1) (car e2)))))))
    
35.       (command "line" (cadr dist) (caddr dist) "")
    
36.       (princ "\n最小距离为：")
    
37.       (princ (car dist))
    
38. 
    
39.     )
    
40.   )
    
41.   (is_simple_obj s1)
    
42.   (is_simple_obj s2)
    
43.   (princ)
    
44. )
    
45. ;____________________________________________________________________________
    
46. ;____________________________________________________________________________
    
47. ;____________________________________________________________________________
    
48. (defun is_pl (e v / s)
    
49.   (if (or (= "POLYLINE" (cdr (assoc 0 (entget e))))
    
50.           (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
    
51.       )
    
52.     (progn
    
53.       (vla-copy v)
    
54.       (command "explode" (entlast))
    
55.       (setq s (ssget "p"))
    
56.     )
    
57.     (setq s (ssadd)
    
58.           s (ssadd e s)
    
59.     )
    
60.   )
    
61.   s
    
62. )
    
63. (defun is_simple_obj (s)
    
64.   (if (> (sslength s) 1)
    
65.     (command "erase" s "")
    
66.   )
    
67. )
    
68. ;____________________________________________________________________________
    
69. ;____________________________________________________________________________
    
70. ;____________________________________________________________________________
    
71. (defun distance_between_arc_and        (a1 a2 / dd en1 en2 di1 di2)
    
72.   (if (= "CIRCLE" (cdr (assoc 0 (entget (vlax-vla-object->ename a1)))))
    
73.     (progn
    
74.       (setq cen1 (vlax-safearray->list (vlax-variant-value (vla-get-center a1))))
    
75.       (setq di3 (vlax-curve-getClosestPointTo a2 cen1))
    
76.       (setq en3 (polar cen1 (angle cen1 di3) (vla-get-radius a1)))
    
77.       (setq dd (append dd (list (list (distance di3 en3) en3 di3))))
    
78.     )
    
79.     (progn
    
80.       (setq en1 (vlax-safearray->list (vlax-variant-value (vla-get-startpoint a1))))
    
81.       (setq en2 (vlax-safearray->list (vlax-variant-value (vla-get-endpoint a1))))
    
82.       (setq cen1 (vlax-safearray->list (vlax-variant-value (vla-get-center a1))))
    
83.       (setq di1 (vlax-curve-getClosestPointTo a2 en1))
    
84.       (setq di2 (vlax-curve-getClosestPointTo a2 en2))
    
85.       (setq di3 (vlax-curve-getClosestPointTo a2 cen1))
    
86.       (setq en3 (polar cen1 (angle cen1 di3) (vla-get-radius a1)))
    
87.       (setq dd (append dd (list (list (distance di1 en1) en1 di1))))
    
88.       (setq dd (append dd (list (list (distance di2 en2) en2 di2))))
    
89.       (if (vlax-curve-getParamAtPoint a1 en3)
    
90.         (setq dd (append dd (list (list (distance di3 en3) en3 di3))))
    
91.       )
    
92.     )
    
93.   )
    
94.   (car (vl-sort dd (function (lambda (e1 e2) (< (car e1) (car e2))))))
    
95. )
    
96. (defun distance_between_line_and (a1 a2 / dd en1 en2 di1 di2)
    
97.   (setq en1 (vlax-safearray->list (vlax-variant-value (vla-get-startpoint a1))))
    
98.   (setq en2 (vlax-safearray->list (vlax-variant-value (vla-get-endpoint a1))))
    
99. 
    
100.   (setq di1 (vlax-curve-getClosestPointTo a2 en1))
     
101.   (setq di2 (vlax-curve-getClosestPointTo a2 en2))
     
102. 
     
103. 
     
104.   (setq dd (append dd (list (list (distance di1 en1) en1 di1))))
     
105.   (setq dd (append dd (list (list (distance di2 en2) en2 di2))))
     
106. 
     
107.   (car (vl-sort dd (function (lambda (e1 e2) (< (car e1) (car e2))))))
     
108. )
     
109. ;____________________________________________________________________________
     
110. ;____________________________________________________________________________
     
111. ;____________________________________________________________________________
     
112. (defun distance_between_ents (e1 e2 / a1 a2 en1 en2 cen1 di1 di2 di3 dd dd_l)
     
113.   (command "osnap" "non")
     
114.   (setq vlo1 (vlax-ename->vla-object e1))
     
115.   (setq vlo2 (vlax-ename->vla-object e2))
     
116.   (setq int (vlax-variant-value (vla-intersectwith vlo1 vlo2 acextendnone)))
     
117.   (if (> (vlax-safearray-get-u-bound int 1) 0)
     
118.     (princ "\n距离为0")
     
119.     (progn
     
120.       (if (or (= "ARC" (cdr (assoc 0 (entget e1))))
     
121.               (= "CIRCLE" (cdr (assoc 0 (entget e1))))
     
122.           )
     
123.         (setq dd_l (append dd_l (list (distance_between_arc_and vlo1 vlo2))))
     
124.         (setq dd_l (append dd_l (list (distance_between_line_and vlo1 vlo2))))
     
125.       )
     
126.       (if (or (= "ARC" (cdr (assoc 0 (entget e2))))
     
127.               (= "CIRCLE" (cdr (assoc 0 (entget e2))))
     
128.           )
     
129.         (setq dd_l (append dd_l (list (distance_between_arc_and vlo2 vlo1))))
     
130.         (setq dd_l (append dd_l (list (distance_between_line_and vlo2 vlo1))))
     
131.       )
     
132.       (setq dd_l (car (vl-sort dd_l (function (lambda (e1 e2) (< (car e1) (car e2)))))))
     
133.       dd_l
     
134.     )
     
135.   )
     
136. )
     
137. ;____________________________________________________________________________
     
138. ;____________________________________________________________________________
     
139. ;____________________________________________________________________________
     
140. (princ "\n求共面曲线间最近距离及最近点的LISP程序__BY__WKAI__晓东CAD论坛")
     
141. 
     
142.   [/FONT]
     

<br />   [FONT=courier new]<br /> ;_求共面曲线间最近距离及最近点的LISP程序__BY__WKAI__晓东CAD论坛______________<br /> ;_2004.01.05.16.02___________________________________________________________<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> (defun c:tt (/ ent1 ent2 n1 n2 dist)<br />   (princ "\n请选择共面的线段、圆、圆弧，或者复义线，第一段:")<br />   (setq vlobject1 (vlax-ename->vla-object (setq ent1 (car (entsel)))))<br />   (princ "\n请选择共面的线段、圆、圆弧，或者复义线，第二段:")<br />   (setq vlobject2 (vlax-ename->vla-object (setq ent2 (car (entsel)))))<br />   (setq int (vlax-variant-value (vla-intersectwith vlobject1 vlobject2 acextendnone)))<br />   (if (> (vlax-safearray-get-u-bound int 1) 0)<br />     (princ "\n最小距离为：0")<br />     (progn<br />       (setq s1 (is_pl ent1 vlobject1))<br />       (setq s2 (is_pl ent2 vlobject2))<br />       (setq n1 0<br />             n2 0<br />       )<br />       (repeat (sslength s1)<br />         (setq ent1 (ssname s1 n1)<br />               n1   (1+ n1)<br />               n2   0<br />         )<br />         (repeat        (sslength s2)<br />           (setq        ent2 (ssname s2 n2)<br />                 n2   (1+ n2)<br />           )<br />           (setq dist (append dist (list (distance_between_ents ent1 ent2))))<br />         )<br />       )<br />       (setq dist (car (vl-sort dist (function (lambda (e1 e2) (< (car e1) (car e2)))))))<br />       (command "line" (cadr dist) (caddr dist) "")<br />       (princ "\n最小距离为：")<br />       (princ (car dist))<br /> <br />     )<br />   )<br />   (is_simple_obj s1)<br />   (is_simple_obj s2)<br />   (princ)<br /> )<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> (defun is_pl (e v / s)<br />   (if (or (= "POLYLINE" (cdr (assoc 0 (entget e))))<br />           (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))<br />       )<br />     (progn<br />       (vla-copy v)<br />       (command "explode" (entlast))<br />       (setq s (ssget "p"))<br />     )<br />     (setq s (ssadd)<br />           s (ssadd e s)<br />     )<br />   )<br />   s<br /> )<br /> (defun is_simple_obj (s)<br />   (if (> (sslength s) 1)<br />     (command "erase" s "")<br />   )<br /> )<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> (defun distance_between_arc_and        (a1 a2 / dd en1 en2 di1 di2)<br />   (if (= "CIRCLE" (cdr (assoc 0 (entget (vlax-vla-object->ename a1)))))<br />     (progn<br />       (setq cen1 (vlax-safearray->list (vlax-variant-value (vla-get-center a1))))<br />       (setq di3 (vlax-curve-getClosestPointTo a2 cen1))<br />       (setq en3 (polar cen1 (angle cen1 di3) (vla-get-radius a1)))<br />       (setq dd (append dd (list (list (distance di3 en3) en3 di3))))<br />     )<br />     (progn<br />       (setq en1 (vlax-safearray->list (vlax-variant-value (vla-get-startpoint a1))))<br />       (setq en2 (vlax-safearray->list (vlax-variant-value (vla-get-endpoint a1))))<br />       (setq cen1 (vlax-safearray->list (vlax-variant-value (vla-get-center a1))))<br />       (setq di1 (vlax-curve-getClosestPointTo a2 en1))<br />       (setq di2 (vlax-curve-getClosestPointTo a2 en2))<br />       (setq di3 (vlax-curve-getClosestPointTo a2 cen1))<br />       (setq en3 (polar cen1 (angle cen1 di3) (vla-get-radius a1)))<br />       (setq dd (append dd (list (list (distance di1 en1) en1 di1))))<br />       (setq dd (append dd (list (list (distance di2 en2) en2 di2))))<br />       (if (vlax-curve-getParamAtPoint a1 en3)<br />         (setq dd (append dd (list (list (distance di3 en3) en3 di3))))<br />       )<br />     )<br />   )<br />   (car (vl-sort dd (function (lambda (e1 e2) (< (car e1) (car e2))))))<br /> )<br /> (defun distance_between_line_and (a1 a2 / dd en1 en2 di1 di2)<br />   (setq en1 (vlax-safearray->list (vlax-variant-value (vla-get-startpoint a1))))<br />   (setq en2 (vlax-safearray->list (vlax-variant-value (vla-get-endpoint a1))))<br /> <br />   (setq di1 (vlax-curve-getClosestPointTo a2 en1))<br />   (setq di2 (vlax-curve-getClosestPointTo a2 en2))<br /> <br /> <br />   (setq dd (append dd (list (list (distance di1 en1) en1 di1))))<br />   (setq dd (append dd (list (list (distance di2 en2) en2 di2))))<br /> <br />   (car (vl-sort dd (function (lambda (e1 e2) (< (car e1) (car e2))))))<br /> )<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> (defun distance_between_ents (e1 e2 / a1 a2 en1 en2 cen1 di1 di2 di3 dd dd_l)<br />   (command "osnap" "non")<br />   (setq vlo1 (vlax-ename->vla-object e1))<br />   (setq vlo2 (vlax-ename->vla-object e2))<br />   (setq int (vlax-variant-value (vla-intersectwith vlo1 vlo2 acextendnone)))<br />   (if (> (vlax-safearray-get-u-bound int 1) 0)<br />     (princ "\n距离为0")<br />     (progn<br />       (if (or (= "ARC" (cdr (assoc 0 (entget e1))))<br />               (= "CIRCLE" (cdr (assoc 0 (entget e1))))<br />           )<br />         (setq dd_l (append dd_l (list (distance_between_arc_and vlo1 vlo2))))<br />         (setq dd_l (append dd_l (list (distance_between_line_and vlo1 vlo2))))<br />       )<br />       (if (or (= "ARC" (cdr (assoc 0 (entget e2))))<br />               (= "CIRCLE" (cdr (assoc 0 (entget e2))))<br />           )<br />         (setq dd_l (append dd_l (list (distance_between_arc_and vlo2 vlo1))))<br />         (setq dd_l (append dd_l (list (distance_between_line_and vlo2 vlo1))))<br />       )<br />       (setq dd_l (car (vl-sort dd_l (function (lambda (e1 e2) (< (car e1) (car e2)))))))<br />       dd_l<br />     )<br />   )<br /> )<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> ;____________________________________________________________________________<br /> (princ "\n求共面曲线间最近距离及最近点的LISP程序__BY__WKAI__晓东CAD论坛")<br /> <br />   [/FONT]<br />

陌生人

wkai是老师？哈。教什么的呀。
看过你几个程序，觉得你功底很扎实，而且写出来的程序赏心悦目。
顺便，(defun distance_between_ents ) 中progn段可用以下代替。欢迎交流。

2. 
   
3. (if (or (member (cdr (assoc 0 (entget e1)))  '("ARC" "CIRCLE"))
   
4.         (member (cdr (assoc 0 (entget e2)))  '("ARC" "CIRCLE")))
   
5.     (setq dd_l (append dd_l (list (distance_between_arc_and vlo2 vlo1))))
   
6.     (setq dd_l (append dd_l (list (distance_between_line_and vlo2 vlo1))))
   
7. )
   

<br /> (if (or (member (cdr (assoc 0 (entget e1)))  '("ARC" "CIRCLE"))<br />         (member (cdr (assoc 0 (entget e2)))  '("ARC" "CIRCLE")))<br />     (setq dd_l (append dd_l (list (distance_between_arc_and vlo2 vlo1))))<br />     (setq dd_l (append dd_l (list (distance_between_line_and vlo2 vlo1))))<br /> )<br />

aeo

上次看到那命题的时候，我就想归根结底就是弧线和直线的关系，可最后想到还有椭圆，还有sline,结果回复的字都输好了，还是没回复.
直线和椭圆，弧线和椭圆，应该可以求，再复杂，我是解不了了.(模拟毕竟是大约)

图形是个学问,我是不可能研究了
下面这个网站真牛呀.

1. 
   
2. <table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="700" id="AutoNumber1" height="900">
   
3.   <tr>
   
4.     <td width="100%" height="489">
   
5.       <iframe name="I1" width="100%" height="100%" src="http://www.saltire.com/applets/advanced_geometry/spline/spline.htm">
   
6. 浏览器不支持嵌入式框架或配置为不显示嵌入式框架
   
7.       </iframe>
   
8.     </td>
   
9.   </tr>
   
10. </table>
    

复制代码

看里面有个画鸡蛋的

aeo

最初由 陌生人 发布
[B]wkai是老师？哈。教什么的呀。
看过你几个程序，觉得你功底很扎实，而且写出来的程序赏心悦目。
顺便，(defun distance_between_ents ) 中progn段可用以下代替。欢迎交流。
[code]
(if (or (member (cdr (assoc ... [/B]

他是正反都求.再最小

wkai

这个可以求任意两条曲线（各种类型，共面与否）的最小距离及最近点。
可以设置叠代次数，足够满足精度需求。

2. 
   
3.   [FONT=courier new]
   
4. ;_2004.01.09.11.40___________________________________
   
5. ;_曲线间最小距离及最近点__BY__WKAI__晓东CAD论坛__
   
6. ;________________________________________________________
   
7. ;________________________________________________________
   
8. (defun c:tt (/ pts min_distacne vlo1 vlo2 st_par ed_par ent n m min_pt str)
   
9.   (setvar "osmode" 0)
   
10.   (setq n (getint "\n叠代次数:"))
    
11.   (if n
    
12.     ()
    
13.     (setq n 2)
    
14.   )
    
15.   (setq        m   1000
    
16.         str ""
    
17.   )
    
18.   (setq vlo_object1 (vlax-ename->vla-object (car (entsel "\n曲线一："))))
    
19.   (setq vlo_object2 (vlax-ename->vla-object (car (entsel "\n曲线二："))))
    
20.   (setq tt1 (t2 vlo_object1 vlo_object2 n m))
    
21.   (setq tt2 (t2 vlo_object2 vlo_object1 n m))
    
22.   (setq        tt (if (> (car tt1) (car tt2))
    
23.              tt2
    
24.              tt1
    
25.            )
    
26.   )
    
27.   (command "ucs" "w")
    
28.   (command "line" (cadr tt) (caddr tt) "")
    
29.   (command "ucs" "p")
    
30.   (princ (strcat "\n叠代次数为" (itoa n) ",最小距离为" (rtos (car tt) 2 20)))
    
31.   (princ "\n最近点1:")
    
32.   (princ (cadr tt))
    
33.   (princ "   最近点2:")
    
34.   (princ (caddr tt))
    
35.   (princ)
    
36. )
    
37. ;________________________________________________________________________
    
38. ;________________________________________________________________________
    
39. ;________________________________________________________________________
    
40. (defun t2 (vlo1 vlo2 rep rod /)
    
41.   (setq        st_par             (vlax-curve-getstartparam vlo1)
    
42.         ed_par             (vlax-curve-getendparam vlo1)
    
43.         pts             (list (vlax-curve-getstartpoint vlo1))
    
44.         min_distacne (/ (vlax-curve-getdistatparam vlo1 ed_par) rod)
    
45.   )
    
46.   (repeat rep
    
47.     (setq pts (list (vlax-curve-getpointatparam vlo1 st_par)))
    
48.     (t1 vlo1 st_par ed_par min_distacne)
    
49.     (setq min_pt (car (vl-sort pts
    
50.                                '(lambda        (s1 s2)
    
51.                                   (< (distance s1 (vlax-curve-getClosestPointTo vlo2 s1))
    
52.                                      (distance s2 (vlax-curve-getClosestPointTo vlo2 s2))
    
53.                                   )
    
54.                                 )
    
55.                       )
    
56.                  )
    
57.     )
    
58.     (setq position (vl-position min_pt pts))
    
59.     (if        (= (1+ position) (length pts))
    
60.       (setq ed_par (vlax-curve-getendparam vlo1))
    
61.       (setq ed_par (if (vlax-curve-getparamatpoint vlo1 (nth (1+ position) pts))
    
62.                      (vlax-curve-getparamatpoint vlo1 (nth (1+ position) pts))
    
63.                      (vlax-curve-getendparam vlo1)
    
64.                    )
    
65.       )
    
66.     )
    
67.     (if        (= position 0)
    
68.       (setq st_par (vlax-curve-getstartparam vlo1))
    
69.       (setq st_par (vlax-curve-getparamatpoint vlo1 (nth (1- position) pts)))
    
70.     )
    
71.     (setq min_distacne
    
72.            (/ (- (vlax-curve-getdistatparam vlo1 ed_par)
    
73.                  (vlax-curve-getdistatparam vlo1 st_par)
    
74.               )
    
75.               rod
    
76.            )
    
77.     )
    
78.   )
    
79.   (list        (distance min_pt (vlax-curve-getClosestPointTo vlo2 min_pt))
    
80.         min_pt
    
81.         (vlax-curve-getClosestPointTo vlo2 min_pt)
    
82.   )
    
83. )
    
84. ;________________________________________________________________________
    
85. ;________________________________________________________________________
    
86. (defun t1 (vl_obj start_par end_par min_dis / dis_m_m ed_p ed_pt mid_p mid_pt mid_pt_vlo st_p st_pt)
    
87.   (setq        st_p           start_par
    
88.         ed_p           end_par
    
89.         st_pt           (vlax-curve-getpointatparam vl_obj st_p)
    
90.         ed_pt           (if (vlax-curve-getpointatparam vl_obj ed_p)
    
91.                      (vlax-curve-getpointatparam vl_obj ed_p)
    
92.                      (vlax-curve-getendpoint vl_obj)
    
93.                    )
    
94.         mid_pt           (mapcar '(lambda (x y) (/ (+ x y) 2.0)) st_pt ed_pt)
    
95.         mid_pt_vlo (vlax-curve-getpointatparam vl_obj (/ (+ st_p ed_p) 2.0))
    
96.         mid_p           (vlax-curve-getparamatpoint vl_obj mid_pt_vlo)
    
97.         dis_m_m           (distance mid_pt_vlo mid_pt)
    
98.   )
    
99.   (if (> dis_m_m min_distacne)
    
100.     (progn
     
101.       (t1 vl_obj st_p mid_p min_dis)
     
102.       (t1 vl_obj mid_p ed_p min_dis)
     
103.     )
     
104.     (setq pts (append pts (list mid_pt_vlo) (list ed_pt)))
     
105.   )
     
106. )
     
107. ;________________________________________________________________________
     
108. ;________________________________________________________________________
     
109. ;________________________________________________________________________
     
110. (princ "\n两条曲线最近距离及最近点__BY__WKAI__晓东CAD论坛")
     
111. (princ "\n命令:tt")
     
112. 
     
113.   [/FONT]
     

<br />   [FONT=courier new]<br /> ;_2004.01.09.11.40___________________________________<br /> ;_曲线间最小距离及最近点__BY__WKAI__晓东CAD论坛__<br /> ;________________________________________________________<br /> ;________________________________________________________<br /> (defun c:tt (/ pts min_distacne vlo1 vlo2 st_par ed_par ent n m min_pt str)<br />   (setvar "osmode" 0)<br />   (setq n (getint "\n叠代次数:"))<br />   (if n<br />     ()<br />     (setq n 2)<br />   )<br />   (setq        m   1000<br />         str ""<br />   )<br />   (setq vlo_object1 (vlax-ename->vla-object (car (entsel "\n曲线一："))))<br />   (setq vlo_object2 (vlax-ename->vla-object (car (entsel "\n曲线二："))))<br />   (setq tt1 (t2 vlo_object1 vlo_object2 n m))<br />   (setq tt2 (t2 vlo_object2 vlo_object1 n m))<br />   (setq        tt (if (> (car tt1) (car tt2))<br />              tt2<br />              tt1<br />            )<br />   )<br />   (command "ucs" "w")<br />   (command "line" (cadr tt) (caddr tt) "")<br />   (command "ucs" "p")<br />   (princ (strcat "\n叠代次数为" (itoa n) ",最小距离为" (rtos (car tt) 2 20)))<br />   (princ "\n最近点1:")<br />   (princ (cadr tt))<br />   (princ "   最近点2:")<br />   (princ (caddr tt))<br />   (princ)<br /> )<br /> ;________________________________________________________________________<br /> ;________________________________________________________________________<br /> ;________________________________________________________________________<br /> (defun t2 (vlo1 vlo2 rep rod /)<br />   (setq        st_par             (vlax-curve-getstartparam vlo1)<br />         ed_par             (vlax-curve-getendparam vlo1)<br />         pts             (list (vlax-curve-getstartpoint vlo1))<br />         min_distacne (/ (vlax-curve-getdistatparam vlo1 ed_par) rod)<br />   )<br />   (repeat rep<br />     (setq pts (list (vlax-curve-getpointatparam vlo1 st_par)))<br />     (t1 vlo1 st_par ed_par min_distacne)<br />     (setq min_pt (car (vl-sort pts<br />                                '(lambda        (s1 s2)<br />                                   (< (distance s1 (vlax-curve-getClosestPointTo vlo2 s1))<br />                                      (distance s2 (vlax-curve-getClosestPointTo vlo2 s2))<br />                                   )<br />                                 )<br />                       )<br />                  )<br />     )<br />     (setq position (vl-position min_pt pts))<br />     (if        (= (1+ position) (length pts))<br />       (setq ed_par (vlax-curve-getendparam vlo1))<br />       (setq ed_par (if (vlax-curve-getparamatpoint vlo1 (nth (1+ position) pts))<br />                      (vlax-curve-getparamatpoint vlo1 (nth (1+ position) pts))<br />                      (vlax-curve-getendparam vlo1)<br />                    )<br />       )<br />     )<br />     (if        (= position 0)<br />       (setq st_par (vlax-curve-getstartparam vlo1))<br />       (setq st_par (vlax-curve-getparamatpoint vlo1 (nth (1- position) pts)))<br />     )<br />     (setq min_distacne<br />            (/ (- (vlax-curve-getdistatparam vlo1 ed_par)<br />                  (vlax-curve-getdistatparam vlo1 st_par)<br />               )<br />               rod<br />            )<br />     )<br />   )<br />   (list        (distance min_pt (vlax-curve-getClosestPointTo vlo2 min_pt))<br />         min_pt<br />         (vlax-curve-getClosestPointTo vlo2 min_pt)<br />   )<br /> )<br /> ;________________________________________________________________________<br /> ;________________________________________________________________________<br /> (defun t1 (vl_obj start_par end_par min_dis / dis_m_m ed_p ed_pt mid_p mid_pt mid_pt_vlo st_p st_pt)<br />   (setq        st_p           start_par<br />         ed_p           end_par<br />         st_pt           (vlax-curve-getpointatparam vl_obj st_p)<br />         ed_pt           (if (vlax-curve-getpointatparam vl_obj ed_p)<br />                      (vlax-curve-getpointatparam vl_obj ed_p)<br />                      (vlax-curve-getendpoint vl_obj)<br />                    )<br />         mid_pt           (mapcar '(lambda (x y) (/ (+ x y) 2.0)) st_pt ed_pt)<br />         mid_pt_vlo (vlax-curve-getpointatparam vl_obj (/ (+ st_p ed_p) 2.0))<br />         mid_p           (vlax-curve-getparamatpoint vl_obj mid_pt_vlo)<br />         dis_m_m           (distance mid_pt_vlo mid_pt)<br />   )<br />   (if (> dis_m_m min_distacne)<br />     (progn<br />       (t1 vl_obj st_p mid_p min_dis)<br />       (t1 vl_obj mid_p ed_p min_dis)<br />     )<br />     (setq pts (append pts (list mid_pt_vlo) (list ed_pt)))<br />   )<br /> )<br /> ;________________________________________________________________________<br /> ;________________________________________________________________________<br /> ;________________________________________________________________________<br /> (princ "\n两条曲线最近距离及最近点__BY__WKAI__晓东CAD论坛")<br /> (princ "\n命令:tt")<br /> <br />   [/FONT]<br />

LUCAS

;;;T1函數看來是沒有甚麼用的?
;;;只要用分段數求點表即可取代T1
;;;疊代次數也應該可用更精確的數值取代

njshf

如果只求空间两条直线间最短距离？

PFD8667

wkai :
麻烦你帮我写一个求曲线间最远距离及最远点的LISP程序,我主要用于排料,能方便的一次定宽度或长度,我不会编程,在论坛上到处求都没有解决,这有恳求你的帮忙了,再次表示谢意!

lihb

写得真好，顶一下。

梦断江南

最初由 LUCAS 发布
[B];;;T1函數看來是沒有甚麼用的?
;;;只要用分段數求點表即可取代T1
;;;疊代次數也應該可用更精確的數值取代 [/B]

的确，我测试了1楼和5楼的程序
5楼的叠代次数即便设置很高（如1000）也无法有效逼进最近距离，和用叠代次数30次求得的结果一样（以1楼测试长度为准）
另外，1楼程序在处理圆弧及其内的椭圆时，有bug，求得的不是最近距离
望能改进

yexuez

为什么执行5楼的程序会出线“no function definition: VLAX-ENAME->VLA-OBJECT”的错误信息？

似水无痕

你试试在程序开头加(vl-load-com)

yexuez

谢谢12楼的，已经可以运行了！

似水无痕

不客气，我是个新手，还希望以后有问题可以请教！

RedCAD

我下来分析一下了