G版和HIGHFLYBIRD及高人请进!如何能求出所有的路径呢?
如何能求出图中所有的路径呢?请见图及附件。如能给出核心代码,将万分感激,若不方便,给个可行的思路亦可!
本帖最后由 Gu_xl 于 2013-4-12 16:15 编辑
更改了下,适用任何曲线!演示命令: GetPath
2012.2.26更新
但程序运行效率上还差强人意,选择的线多了后,速度还成问题,代码还需优化!等我有时间慢慢优化一下,届时再公布核心代码吧!请耐心等待。。。
先公布一下VLX中打包的计算路径函数用法,你可以根据自己实际需要来使用:
函数名称: GetPath
函数用法: (GetPath SS STARTPOINT ENDPOINTFUZZ)
参数: SS = 曲线选择集 StartPoint = 路径起点 EndPoint = 路径终点 Fuzz = 容差精度
函数返回值: 返回路径弧段图元名表,按长度从小到大排序 '((弧段1图元名 弧段2图元名 ...) ;_ 路径1
((弧段n图元名 弧段n+1图元名 ...);_ 路径n
...)
用法示例: (setq ll (GetPath (ssget '((0 . "*line,arc,circle,ellipse"))) (getpoint "\n起点:") (getpoint "\n终点点:") 0.001))
2012.2.23 公布核心代码如下:
;;;搜索所有路径演示图
;;; /------------\
;;;/--|----------\ |
;;;|0 -------- 1 |
;;;|| \ /| |
;;;||\ / | |
;;;|| \ 2 /| |
;;;|| /\ | |
;;;||/ \| |
;;;|| / \ | |
;;;\--3 ------- 4--/
;;(c:getpath)
(defun c:getpath (/ SS FUZZ DATA ENT-NODES NODE-COORDS
NODES IARCS ARC->NODES arcs
NODE->ARCSL MAKEPATHENTSTART
ENTDATA PT NODE1 P1 NODE2
P2 STARTNODE ENDNODE K oldpath
P PATH OLDENT NodePath arcpath EntArcs Sorti)
;| 上图的演示测试数据
;;结点表
(setq nodes '(0 1 2 3 4))
;;无向弧段表
(setq arcs '(0 1 2 3 4 5 6 7 8 9))
;;弧段-结点表
(setq arc->Nodes '((0 1) (0 2) (0 3) (0 4)
(1 2) (1 3) (1 4)
(2 3) (2 4)
(3 4)
)
)
;;结点-弧段表
(setq Node->Arcs '((0 1 2 3)
(0 4 5 6)
(1 4 7 8)
(2 5 7 9)
(3 6 8 9)
)
)
(setq startNode 0 EndNode 3)
|;
;;递归法计算路径 参数 :起点编号 终点编号 储存的路径结点数据 储存的路径弧段数据表
(defun makepath (STARTNODE ENDNODE NODEDATA arcdata/ ARCS NODES NODE )
(setq arcs (nth startnode Node->Arcs)) ;_ 与起点相连的弧段表
(foreach a arcdata (setq arcs (vl-remove a arcs))) ;_ 移除已在路径中的弧段
;;逐个弧段分别扩展路径
(foreach arc arcs
(setq nodes (nth arc arc->Nodes)) ;_ 弧段两端的节点编号
(setq node (car (vl-remove startnode nodes))) ;_ 移除已在路径中的结点,得到下一结点编号
(cond
((= node EndNode) ;_ 若下一结点为终止点,则找到一条路径
(setq NodePath (cons (reverse (cons node Nodedata)) NodePath)) ;_ 返回路径结点表
(setq ArcPath (cons (reverse (cons arc arcdata)) ArcPath)) ;_ 返回路径结点表
)
;;若下一结点不在路径中,以下一结点为起始点,继续搜索路径,否则是此路不通
((not (member node Nodedata)) (makepath node endnode(cons node Nodedata) (cons arc arcdata)))
)
)
)
; (setierr)
(setq ss (ssget '((0 . "*line,arc,circle,ellipse"))))
(setq Fuzz (getreal "\n 容差精度<0.001>:"))
(if (null Fuzz) (setq Fuzz 0.001))
(princ "\n**曲线打断,请等待...") (princ)
;;曲线选择集交点打断,返回打断后的选择集
(setq ss (GXL-BREAK_SSFuzz ss Fuzz)) ;_
(princ (strcat "打断后曲线总数为: " (itoa (sslength ss)) " 个.")) (princ)
(princ "\n**构建弧段--结点数据表,请等待...") (princ)
;;构建弧段图元和结点编号数据表,返回值:图元名--节点编号表 '((图元名 首节点编号 末节点编号)...) 节点--坐标表 '((节点编号 坐标)...)
;; gxl-ent->Nodes 函数代码在 http://bbs.mjtd.com/thread-82692-1-1.html 帖子里有
(setq data (gxl-ent->Nodes (GXL-SEL-SS->LIST ss) Fuzz))
(setq Ent-nodes (car data) ;_ 图元名--节点编号表 '((图元名 首节点编号 末节点编号)...)
EntArcs (mapcar 'car Ent-nodes) ;_ 弧段图元名表
node-coords (cadr data) ;_ 节点--坐标表 '((节点编号 坐标)...)
)
(setq nodes (mapcar 'car node-coords) ;_ 结点表
i -1
arcs (mapcar '(lambda (x) (setq i (1+ i))) Ent-nodes) ;_ 无向弧段表
arc->Nodes (mapcar 'cdr Ent-nodes) ;_ 弧段-结点表
)
;;建立结点-弧段表 Node->Arcs
(setq Node->Arcs (mapcar
'(lambda (x / i l)
(setq i -1)
(mapcar '(lambda (a) (setq i (1+ i)) (if (member x a) (setq l (cons i l)))) arc->Nodes)
l
)
nodes
)
)
(setvar 'osmode 111)
(while
(not
(progn
(setq StartPoint (getpoint "\n选择起点:"))
(vl-some '(lambda (x) (if (equal (cadr x) StartPoint Fuzz) (setq startNode (car x)))) node-coords)
startNode
)
)
(princ "\n选择的起点不在节点上,请重新选择!")
)
(while
(not
(progn
(setq EndPoint (getpoint "\n选择终点:"))
(vl-some '(lambda (x) (if (equal (cadr x) EndPoint Fuzz) (setq EndNode (car x)))) node-coords)
EndNode
)
)
(princ "\n选择的终点不在节点上,请重新选择!")
)
(setvar 'osmode 0)
(princ "\n**计算所有路径,请等待...") (princ)
;;计算路径,路径结点数据表存储在表 NodePath ,路径弧段数据表存储在表 ArcPath
(makepath startNode EndNode (list startNode) nil)
;;路径结点表 NodePath '((结点1 结点2 ...) (结点n 结点n+1 ...) ...)
;;路径弧段数据表 ArcPath '((弧段1 弧段2 ...) (弧段n 弧段n+1 ...) ...)
(princ (strcat "\n**共有 " (itoa (length NodePath)) " 条路径**"))
(if ArcPath
(progn
;;对弧段表按路径长度从小到大排序,返回排序后的索引表
(setq Sorti
(vl-sort-i ArcPath
'(lambda (a b)
(<
(apply '+
(mapcar '(lambda (X / en)
(setq en (nth x EntArcs))
(vlax-curve-getDistAtParam
en
(vlax-curve-getEndParam en)
)
)
a
)
)
(apply '+
(mapcar '(lambda (X / en)
(setq en (nth x EntArcs))
(vlax-curve-getDistAtParam
en
(vlax-curve-getEndParam en)
)
)
b
)
)
)
)
)
)
(princ "\n显示为红色的是最短路径")
(mapcar '(lambda (x) (GXL-CH_ENT (nth x EntArcs) 62 1)) (nth (car Sorti) ArcPath))
(setq i (length ArcPath) k -1)
(while (setq p (getpoint "\n**左键循环显示路径,右键退出**"))
(setq k (rem (1+ k) i) )
;(setq path (nth k NodePath))
(princ (strcat " 第 " (itoa (1+ k)) "条路径"))
(if oldpath (mapcar '(lambda (x) (redraw (nth x EntArcs) 4)) oldpath))
(setq path (nth (nth k Sorti) ArcPath))
(mapcar '(lambda (x) (redraw (nth x EntArcs) 3)) path)
(setq oldpath path)
)
)
)
;(reerr)
(princ)
)
(defun gxl-Sel-SS->List (ss / i s )
(if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
)
)
)
百度一下 “两点之间所有路径的算法”,就会有你要的答案!
。
本帖最后由 yjr111 于 2012-2-16 21:33 编辑Gu_xl 发表于 2012-2-16 21:18 static/image/common/back.gif
百度一下 “两点之间所有路径的算法”,就会有你要的答案!
谢谢G版,搜了一下的确有,不过好像没有用lsp写的,请G版再具体一下链接地址
有向无环的本人已经用递归解决,好像方法竟然与百度里异曲同工。。。
Gu_xl 发表于 2012-2-16 21:18 static/image/common/back.gif
百度一下 “两点之间所有路径的算法”,就会有你要的答案!
G版,俺算法没学过,你不稍微讲解一下,要搞出这么复杂的东东不可能的啊 本帖最后由 flytoday 于 2012-2-17 00:52 编辑
顶起来…请G版赞助点技术哈… 给你一个网址http://www.2cto.com/kf/201104/88040.html,自己改改试试 不能沉啊,请各位大大帮帮忙了 帮顶一下,不能沉 G版很忙,highflybird也没吱一声,其余高人都在坐潜水艇,哎