求两条多段线间最近的距离

marting

1. (defun _nearestpolypoints ( en1 en2 )
   
2.     (   (lambda ( lst / dis rtn tmp )
   
3.             (setq rtn (car lst)
   
4.                   dis (apply 'distance rtn)
   
5.             )
   
6.             (foreach itm (cdr lst)
   
7.                 (if (< (setq tmp (apply 'distance itm)) dis)
   
8.                     (setq dis tmp rtn itm)
   
9.                 )
   
10.             )
    
11.             rtn
    
12.         )
    
13.         (apply 'append
    
14.             (mapcar
    
15.                '(lambda ( a b )
    
16.                     (mapcar
    
17.                        '(lambda ( p )
    
18.                             (list (trans (cdr p) a 0)
    
19.                                   (vlax-curve-getclosestpointto b (trans (cdr p) a 0))
    
20.                             )
    
21.                         )
    
22.                         (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget a))
    
23.                     )
    
24.                 )
    
25.                 (list en1 en2) (list en2 en1)
    
26.             )
    
27.         )
    
28.     )
    
29. )
    
30. 
    
31. (defun c:test ( / ftr pl1 pl2 )
    
32.     (setq ftr '((0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>")))
    
33.     (if (and (princ "\nSelect 1st polyline: ")
    
34.              (setq pl1 (ssget "_+.:E:S" ftr))
    
35.              (princ "\nSelect 2nd polyline: ")
    
36.              (setq pl2 (ssget "_+.:E:S" ftr))
    
37.         )
    
38.         (foreach pnt (_nearestpolypoints (ssname pl1 0) (ssname pl2 0))
    
39.             (entmake (list '(0 . "POINT") (cons 10 pnt)))
    
40.         )
    
41.     )
    
42.     (princ)
    
43. )
    

(defun _nearestpolypoints ( en1 en2 )<br />     (   (lambda ( lst / dis rtn tmp )<br />             (setq rtn (car lst)<br />                   dis (apply 'distance rtn)<br />             )<br />             (foreach itm (cdr lst)<br />                 (if (< (setq tmp (apply 'distance itm)) dis)<br />                     (setq dis tmp rtn itm)<br />                 )<br />             )<br />             rtn<br />         )<br />         (apply 'append<br />             (mapcar<br />                '(lambda ( a b )<br />                     (mapcar<br />                        '(lambda ( p )<br />                             (list (trans (cdr p) a 0)<br />                                   (vlax-curve-getclosestpointto b (trans (cdr p) a 0))<br />                             )<br />                         )<br />                         (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget a))<br />                     )<br />                 )<br />                 (list en1 en2) (list en2 en1)<br />             )<br />         )<br />     )<br /> )<br /> <br /> (defun c:test ( / ftr pl1 pl2 )<br />     (setq ftr '((0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>")))<br />     (if (and (princ "\nSelect 1st polyline: ")<br />              (setq pl1 (ssget "_+.:E:S" ftr))<br />              (princ "\nSelect 2nd polyline: ")<br />              (setq pl2 (ssget "_+.:E:S" ftr))<br />         )<br />         (foreach pnt (_nearestpolypoints (ssname pl1 0) (ssname pl2 0))<br />             (entmake (list '(0 . "POINT") (cons 10 pnt)))<br />         )<br />     )<br />     (princ)<br /> )<br />

上面代码只适合直线段的POLYLINE。

ll_j

考虑凸度了没？

/db_自贡黄明儒_

ll_j 发表于 2017-7-14 15:01

代码这么短，如果考虑了凸度就神了。

newer

ll_j 发表于 2017-7-14 15:01

LISP去处理任意曲线的最近距离是很难完成的任务。
下面代码，用ARX的几何库，求任意两条曲线的最近距离，并连线。

1. (defun c:tt ()
   
2.   (if (and (setq e1 (car (entsel)))
   
3.            (setq g1 (xdge::constructor e1))
   
4.            (setq e2 (car (entsel)))
   
5.            (setq g2 (xdge::constructor e2))
   
6.            (setq dis (xdge::getpropertyvalue g1 "distanceto" g2))
   
7.            (setq p (xdge::getpropertyvalue g1 "closestpointto" g2))
   
8.       )
   
9.     (xdrx_prompt "\n两曲线最近距离:" dis)
   
10.   )
    
11.   (princ)
    
12. )
    

(defun c:tt ()<br />   (if (and (setq e1 (car (entsel)))<br />            (setq g1 (xdge::constructor e1))<br />            (setq e2 (car (entsel)))<br />            (setq g2 (xdge::constructor e2))<br />            (setq dis (xdge::getpropertyvalue g1 "distanceto" g2))<br />            (setq p (xdge::getpropertyvalue g1 "closestpointto" g2))<br />       )<br />     (xdrx_prompt "\n两曲线最近距离:" dis)<br />   )<br />   (princ)<br /> )<br />

命令: tt

选择对象:
选择对象:
两曲线最近距离:19.6892

sicky111

不错。