如何在多点之间绘制最短的不交叉连线（附一个用于植物图块标注的程序源码）

tm20038175

hb198075 发表于 2012-4-1 17:34
想了一天总算搞出来了，虽然法子比较笨，运算也有些慢，不过在处理100个图块以下时速度还是能忍受的，关键是 ...

东西很好，效率很差，呵呵，还是要赞一个~~~~~~~
慢慢改进~~~

xiaotao

妙极了，最后连起来的线是不是最短的？

qjchen

这个问题差不多是最小旅行商问题

是属于NP难问题，暴力算法在n达到10几的时候会开始陷入困境

采用遗传算法、退火算法或者蚁群算法可以达到比较好的最优解。

去年底曾经利用别人的C#遗传算法（http://www.lalena.com/AI/Tsp/ 的遗传算法）改造了一下，使其在CAD中能应用，速度还是挺快的。
不过代码大部分都是上面那个网站的，就不能发了，只能自用一下。



用MATLAB结合LISP来求解这个也是不错的思路。

另，假如你需要LISP解的话

两年多前，Elpanov Evgeniy和Lee Mac曾经采用遗传算法求解过这个类似的问题。
http://www.theswamp.org/index.php?topic=30434.0

tm20038175

qjchen 发表于 2012-4-2 18:34
这个问题差不多是最小旅行商问题

是属于NP难问题，暴力算法在n达到10几的时候会开始陷入困境

代码能私下交流吗？感觉这个算法很好，想收藏下。
如果可以的话，我的邮箱：cjp20038175@hotmail.com

DWS16888

终于找到了  亲啊  亲啊

DWS16888

砸来这么个事情啊

lz123456

看看源码先

tm20038175

qjchen 发表于 2012-4-2 18:34
这个问题差不多是最小旅行商问题

是属于NP难问题，暴力算法在n达到10几的时候会开始陷入困境

楼上一直没有登陆吗，这么好的程序不能一个人独享呀，好多人都翘首期盼着呢！！！！

tm20038175

来自：http://www.theswamp.org/index.ph ... &topic=30434.75
作者：ElpanovEvgeniy

• Swamp Rat
  

1. (defun test (l / D D0 D1 E ENT EP LL LS P)
   
2. (setq ll  (list (apply (function mapcar) (cons (function min) l))
   
3.                  (apply (function mapcar) (cons (function max) l))
   
4.            ) ;_  append
   
5.        ll  (list (car ll) (list (caadr ll) (cadar ll)) (cadr ll) (list (caar ll) (cadadr ll)))
   
6.        ent (entmakex (append (list '(0 . "LWPOLYLINE")
   
7.                                    '(100 . "AcDbEntity")
   
8.                                    '(8 . "temp")
   
9.                                    '(62 . 1)
   
10.                                    '(100 . "AcDbPolyline")
    
11.                                    (cons 90 (length l))
    
12.                                    '(70 . 1)
    
13.                              ) ;_  list
    
14.                              (mapcar (function (lambda (a) (cons 10 a))) ll)
    
15.                      ) ;_  append
    
16.            ) ;_  entmakex
    
17.        l   (mapcar
    
18.             (function cddr)
    
19.             (vl-sort
    
20.              (mapcar (Function (lambda (a / b)
    
21.                                 (cons (distance a (setq b (vlax-curve-getClosestPointTo ent a)))
    
22.                                       (cons (vlax-curve-getParamAtPoint ent b) a)
    
23.                                 ) ;_  cons
    
24.                                ) ;_  lambda
    
25.                      ) ;_  Function
    
26.                      l
    
27.              ) ;_  mapcar
    
28.              (function (lambda (a b)
    
29.                         (if (equal (car a) (car b) 1)
    
30.                          (<= (cadr a) (cadr b))
    
31.                          (< (car a) (car b))
    
32.                         ) ;_  if
    
33.                        ) ;_  lambda
    
34.              ) ;_  function
    
35.             ) ;_  vl-sort
    
36.            ) ;_  mapcar
    
37.        ls  l
    
38. ) ;_  setq
    
39. (foreach a ll (setq ls (vl-remove a ls)))
    
40. (foreach a ls
    
41.   (setq p (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a))
    
42.         p (if (zerop (rem p 1.))
    
43.            (if (zerop p)
    
44.             (vlax-curve-getEndParam ent)
    
45.             (1- p)
    
46.            ) ;_  if
    
47.            (fix p)
    
48.           ) ;_  if
    
49.         p (vlax-curve-getPointAtParam ent p)
    
50.         p (list 10 (car p) (cadr p))
    
51.   ) ;_  setq
    
52.   (entmod (append (reverse (member p (reverse (entget ent))))
    
53.                   (list (cons 10 a))
    
54.                   (cdr (member p (entget ent)))
    
55.           ) ;_  append
    
56.   ) ;_  entmod
    
57. ) ;_  foreach
    
58. (foreach a l (setq ll (vl-remove a ll)))
    
59. (entmod (vl-remove-if (function (lambda (a) (member (cdr a) ll))) (entget ent)))
    
60. (setq l  (mapcar (function cdr)
    
61.                   (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget ent))
    
62.           ) ;_  mapcar
    
63.        l  (mapcar (function list) (cons (last l) l) l)
    
64.        ep (length l)
    
65. ) ;_  setq
    
66. (defun f1 (a ent / p)
    
67.   (setq p (vlax-curve-getPointAtParam
    
68.            ent
    
69.            (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a)))
    
70.           ) ;_  vlax-curve-getPointAtParam
    
71.         p (list 10 (car p) (cadr p))
    
72.   ) ;_  setq ;_  setq
    
73.   (entmod (append (reverse (member p (reverse (entget ent))))
    
74.                   (list (cons 10 a))
    
75.                   (cdr (member p (entget ent)))
    
76.           ) ;_  append
    
77.   ) ;_  entmod
    
78. ) ;_  defun
    
79. (setq d0 (vlax-curve-getDistAtParam ent ep))
    
80. (while
    
81.   (> d0
    
82.      (progn
    
83.       (foreach a l
    
84.        (setq e (entget ent)
    
85.              d (vlax-curve-getDistAtParam ent ep)
    
86.        ) ;_  setq
    
87.        (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))
    
88.        (f1 (car a) ent)
    
89.        (f1 (cadr a) ent)
    
90.        (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))
    
91.         (entmod e)
    
92.         (setq d d1
    
93.               e (entget ent)
    
94.         ) ;_  setq
    
95.        ) ;_  if
    
96.        (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))
    
97.        (f1 (cadr a) ent)
    
98.        (f1 (car a) ent)
    
99.        (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))
    
100.         (entmod e)
     
101.         (setq d d1
     
102.               e (entget ent)
     
103.         ) ;_  setq
     
104.        ) ;_  if
     
105.       ) ;_  foreach
     
106.       d
     
107.      ) ;_  progn
     
108.   ) ;_  <
     
109.   (setq d0 d)
     
110. ) ;_  while
     
111. (princ (strcat "\nPolyline Length: " (rtos d 2 4) " mm."))
     
112. (princ)
     

(defun test (l / D D0 D1 E ENT EP LL LS P)<br /> (setq ll  (list (apply (function mapcar) (cons (function min) l))<br />                  (apply (function mapcar) (cons (function max) l))<br />            ) ;_  append<br />        ll  (list (car ll) (list (caadr ll) (cadar ll)) (cadr ll) (list (caar ll) (cadadr ll)))<br />        ent (entmakex (append (list '(0 . "LWPOLYLINE")<br />                                    '(100 . "AcDbEntity")<br />                                    '(8 . "temp")<br />                                    '(62 . 1)<br />                                    '(100 . "AcDbPolyline")<br />                                    (cons 90 (length l))<br />                                    '(70 . 1)<br />                              ) ;_  list<br />                              (mapcar (function (lambda (a) (cons 10 a))) ll)<br />                      ) ;_  append<br />            ) ;_  entmakex<br />        l   (mapcar<br />             (function cddr)<br />             (vl-sort<br />              (mapcar (Function (lambda (a / b)<br />                                 (cons (distance a (setq b (vlax-curve-getClosestPointTo ent a)))<br />                                       (cons (vlax-curve-getParamAtPoint ent b) a)<br />                                 ) ;_  cons<br />                                ) ;_  lambda<br />                      ) ;_  Function<br />                      l<br />              ) ;_  mapcar<br />              (function (lambda (a b)<br />                         (if (equal (car a) (car b) 1)<br />                          (<= (cadr a) (cadr b))<br />                          (< (car a) (car b))<br />                         ) ;_  if<br />                        ) ;_  lambda<br />              ) ;_  function<br />             ) ;_  vl-sort<br />            ) ;_  mapcar<br />        ls  l<br /> ) ;_  setq<br /> (foreach a ll (setq ls (vl-remove a ls)))<br /> (foreach a ls<br />   (setq p (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a))<br />         p (if (zerop (rem p 1.))<br />            (if (zerop p)<br />             (vlax-curve-getEndParam ent)<br />             (1- p)<br />            ) ;_  if<br />            (fix p)<br />           ) ;_  if<br />         p (vlax-curve-getPointAtParam ent p)<br />         p (list 10 (car p) (cadr p))<br />   ) ;_  setq<br />   (entmod (append (reverse (member p (reverse (entget ent))))<br />                   (list (cons 10 a))<br />                   (cdr (member p (entget ent)))<br />           ) ;_  append<br />   ) ;_  entmod<br /> ) ;_  foreach<br /> (foreach a l (setq ll (vl-remove a ll)))<br /> (entmod (vl-remove-if (function (lambda (a) (member (cdr a) ll))) (entget ent)))<br /> (setq l  (mapcar (function cdr)<br />                   (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget ent))<br />           ) ;_  mapcar<br />        l  (mapcar (function list) (cons (last l) l) l)<br />        ep (length l)<br /> ) ;_  setq<br /> (defun f1 (a ent / p)<br />   (setq p (vlax-curve-getPointAtParam<br />            ent<br />            (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a)))<br />           ) ;_  vlax-curve-getPointAtParam<br />         p (list 10 (car p) (cadr p))<br />   ) ;_  setq ;_  setq<br />   (entmod (append (reverse (member p (reverse (entget ent))))<br />                   (list (cons 10 a))<br />                   (cdr (member p (entget ent)))<br />           ) ;_  append<br />   ) ;_  entmod<br /> ) ;_  defun<br /> (setq d0 (vlax-curve-getDistAtParam ent ep))<br /> (while<br />   (> d0<br />      (progn<br />       (foreach a l<br />        (setq e (entget ent)<br />              d (vlax-curve-getDistAtParam ent ep)<br />        ) ;_  setq<br />        (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))<br />        (f1 (car a) ent)<br />        (f1 (cadr a) ent)<br />        (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))<br />         (entmod e)<br />         (setq d d1<br />               e (entget ent)<br />         ) ;_  setq<br />        ) ;_  if<br />        (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))<br />        (f1 (cadr a) ent)<br />        (f1 (car a) ent)<br />        (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))<br />         (entmod e)<br />         (setq d d1<br />               e (entget ent)<br />         ) ;_  setq<br />        ) ;_  if<br />       ) ;_  foreach<br />       d<br />      ) ;_  progn<br />   ) ;_  <<br />   (setq d0 d)<br /> ) ;_  while<br /> (princ (strcat "\nPolyline Length: " (rtos d 2 4) " mm."))<br /> (princ)<br />

tm20038175

不错，很好，就是这个，谢谢斑竹提醒，不明白为什么会多出了一个点，不知道有没有高手能指出这个多出的点怎么来的~~~~