hb198075 发表于 2012-4-1 17:34 static/image/common/back.gif
想了一天总算搞出来了，虽然法子比较笨，运算也有些慢，不过在处理100个图块以下时速度还是能忍受的，关键是 ...
东西很好，效率很差，呵呵，还是要赞一个~~~~~~~
慢慢改进~~~
妙极了，最后连起来的线是不是最短的？
本帖最后由 qjchen 于 2012-4-3 07:27 编辑
这个问题差不多是最小旅行商问题
是属于NP难问题，暴力算法在n达到10几的时候会开始陷入困境
采用遗传算法、退火算法或者蚁群算法可以达到比较好的最优解。
去年底曾经利用别人的C#遗传算法（http://www.lalena.com/AI/Tsp/ 的遗传算法）改造了一下，使其在CAD中能应用，速度还是挺快的。
不过代码大部分都是上面那个网站的，就不能发了，只能自用一下。
http://qjchen.mjtd.com/wp-content/uploads/2012/01/tsp2.gif
用MATLAB结合LISP来求解这个也是不错的思路。
另，假如你需要LISP解的话
两年多前，Elpanov Evgeniy和Lee Mac曾经采用遗传算法求解过这个类似的问题。
http://www.theswamp.org/index.php?topic=30434.0
qjchen 发表于 2012-4-2 18:34
这个问题差不多是最小旅行商问题
是属于NP难问题，暴力算法在n达到10几的时候会开始陷入困境
代码能私下交流吗？感觉这个算法很好，想收藏下。
如果可以的话，我的邮箱：cjp20038175@hotmail.com
终于找到了亲啊亲啊
砸来这么个事情啊
看看源码先
qjchen 发表于 2012-4-2 18:34
这个问题差不多是最小旅行商问题
是属于NP难问题，暴力算法在n达到10几的时候会开始陷入困境
楼上一直没有登陆吗，这么好的程序不能一个人独享呀，好多人都翘首期盼着呢！！！！
本帖最后由 tm20038175 于 2012-4-23 22:13 编辑
来自：http://www.theswamp.org/index.php?PHPSESSID=2qvlo6j3alifer4itd6djacte6&topic=30434.75
作者：ElpanovEvgeniy
[*]Swamp Rat
(defun test (l / D D0 D1 E ENT EP LL LS P)
(setq ll(list (apply (function mapcar) (cons (function min) l))
(apply (function mapcar) (cons (function max) l))
) ;_append
ll(list (car ll) (list (caadr ll) (cadar ll)) (cadr ll) (list (caar ll) (cadadr ll)))
ent (entmakex (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(8 . "temp")
'(62 . 1)
'(100 . "AcDbPolyline")
(cons 90 (length l))
'(70 . 1)
) ;_list
(mapcar (function (lambda (a) (cons 10 a))) ll)
) ;_append
) ;_entmakex
l (mapcar
(function cddr)
(vl-sort
(mapcar (Function (lambda (a / b)
(cons (distance a (setq b (vlax-curve-getClosestPointTo ent a)))
(cons (vlax-curve-getParamAtPoint ent b) a)
) ;_cons
) ;_lambda
) ;_Function
l
) ;_mapcar
(function (lambda (a b)
(if (equal (car a) (car b) 1)
(<= (cadr a) (cadr b))
(< (car a) (car b))
) ;_if
) ;_lambda
) ;_function
) ;_vl-sort
) ;_mapcar
lsl
) ;_setq
(foreach a ll (setq ls (vl-remove a ls)))
(foreach a ls
(setq p (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a))
p (if (zerop (rem p 1.))
(if (zerop p)
(vlax-curve-getEndParam ent)
(1- p)
) ;_if
(fix p)
) ;_if
p (vlax-curve-getPointAtParam ent p)
p (list 10 (car p) (cadr p))
) ;_setq
(entmod (append (reverse (member p (reverse (entget ent))))
(list (cons 10 a))
(cdr (member p (entget ent)))
) ;_append
) ;_entmod
) ;_foreach
(foreach a l (setq ll (vl-remove a ll)))
(entmod (vl-remove-if (function (lambda (a) (member (cdr a) ll))) (entget ent)))
(setq l(mapcar (function cdr)
(vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget ent))
) ;_mapcar
l(mapcar (function list) (cons (last l) l) l)
ep (length l)
) ;_setq
(defun f1 (a ent / p)
(setq p (vlax-curve-getPointAtParam
ent
(fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a)))
) ;_vlax-curve-getPointAtParam
p (list 10 (car p) (cadr p))
) ;_setq ;_setq
(entmod (append (reverse (member p (reverse (entget ent))))
(list (cons 10 a))
(cdr (member p (entget ent)))
) ;_append
) ;_entmod
) ;_defun
(setq d0 (vlax-curve-getDistAtParam ent ep))
(while
(> d0
(progn
(foreach a l
(setq e (entget ent)
d (vlax-curve-getDistAtParam ent ep)
) ;_setq
(entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))
(f1 (car a) ent)
(f1 (cadr a) ent)
(if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))
(entmod e)
(setq d d1
e (entget ent)
) ;_setq
) ;_if
(entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))
(f1 (cadr a) ent)
(f1 (car a) ent)
(if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))
(entmod e)
(setq d d1
e (entget ent)
) ;_setq
) ;_if
) ;_foreach
d
) ;_progn
) ;_<
(setq d0 d)
) ;_while
(princ (strcat "\nPolyline Length: " (rtos d 2 4) " mm."))
(princ)
不错，很好，就是这个，谢谢斑竹提醒，不明白为什么会多出了一个点，不知道有没有高手能指出这个多出的点怎么来的~~~~