两点间的所有路径的算法

mynameissnow · 发表于 2019-4-19 10:07

G版和HIGHFLYBIRD及高人请进!如何能求出所有的路径呢？
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92071&fromuid=7326095
(出处: 明经CAD社区)

上面这个帖子是之前G版做的一个关于求两点间所有路径的lisp代码，因为发帖较少，看不了核心代码，有没有朋友发一下，在此感谢，或者给出类似lisp程序也行，只要达到相同效果，在此感谢各位大神惠临

mynameissnow · 发表于 2019-4-19 10:16

本帖最后由 mynameissnow 于 2019-4-22 11:17 编辑

谢谢，权限够了，在此贴出来，以飨读者，感谢G版，感谢明经论坛，一个有大神的地方，一个学习成长的地方！

;;;搜索所有路径演示图
;;; /------------\
;;;/--|----------\ |
;;;| 0 -------- 1 |
;;;| | \ /| |
;;;| | \ / | |
;;;| | \ 2 / | |
;;;| | / \ | |
;;;| | / \ | |
;;;| | / \ | |
;;;\--3 ------- 4--/
;;(c:getpath)
(defun c:getpath (/ SS FUZZ DATA ENT-NODES NODE-COORDS
NODES I ARCS ARC->NODES arcs
NODE->ARCS L MAKEPATH ENTSTART
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 函数代码在 <a href="http://bbs.mjtd.com/thread-82692-1-1.html" target="_blank">http://bbs.mjtd.com/thread-82692-1-1.html</a> 帖子里有
(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))
)
)
)

crtrccrt · 发表于 2019-4-21 21:01

程序不分行，可读性差

mynameissnow · 发表于 2019-4-22 11:18

crtrccrt 发表于 2019-4-21 21:01
程序不分行，可读性差

感谢指正，已经重新排版

账号		自动登录	找回密码
密码			注册

[提问] 两点间的所有路径的算法