求最远路径的问题。。

wowan1314 · 发表于 2013-8-1 11:37:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

大家无聊的时候来思考下这个问题吧。
1。如图线的转弯处、线与线，线与喷头处均已打断于点，
然后选择起始线，即可得出所有路径中最远的路径，并弄成选择状态以便查看。

zhang8755 · 发表于 2013-8-1 13:24:11

首先要限定走过的路不能重复走！

wowan1314 · 发表于 2013-8-1 13:30:29

zhang8755 发表于 2013-8-1 13:24
首先要限定走过的路不能重复走！

完全一样的路径肯定是走一次就够了。
从起点走到相连线的末端算一个路径。这个图里有很多路径。
要把所有的路径求出来比较才能得出最长的路径。

wowan1314 · 发表于 2013-8-1 13:57:05

本帖最后由 wowan1314 于 2013-8-1 13:58 编辑

整难了？大家都不来发言呀！

贴个G版一键选中所有相连的线的代码。G版说这个代码再小改就能实现要求。我对递归理解不好。大家来试试吧。

;;选择直线相连 By Gu_xl
(defun c:tt(/ gxl-Sel-ReDrawSel gxl-Sel-SSsub gxl-Sel-SSJoin gxl-sel-SSgetLineatPoint getline)
(defun gxl-Sel-ReDrawSel (Sel mode / m n)
(setq m (sslength Sel)
n 0)
(repeat m
(redraw (ssname Sel n) mode)
(setq n (1+ n))
);repeat
)
(defun gxl-Sel-SSsub(ss1 ss2 / ss n)
(cond
((and ss1 ss2)
(setq n 0)
(repeat (sslength ss2)
(ssdel (ssname ss2 n) ss1)
(setq n (1+ n))
)
)
((and ss1 (not ss2))
ss1
)
(T
(setq ss1 nil)
)
)
ss1
)
(defun gxl-Sel-SSJoin ( ss1 ss2 / ename ss cnt )
(if ss1
(progn
(if (= (type ss1) 'ENAME)
(progn
(setq
ename ss1
ss1 (ssadd)
)
(ssadd ename ss1)
))
))
(if ss2
(progn
(if (= (type ss2) 'ENAME)
(progn
(setq
ename ss2
ss2 (ssadd)
)
(ssadd ename ss2)
))
))
(setq ss (ssadd))
(if (and ss1 ss2)
(progn
;(setq ss ss2 cnt 0)
(setq cnt 0)
(repeat (sslength ss2)
(ssadd (ssname ss2 cnt) ss)
(setq cnt (1+ cnt))
)
(setq cnt 0)
(repeat (sslength ss1)
(ssadd (ssname ss1 cnt) ss)
(setq cnt (1+ cnt))
)
))
(if (and ss1 (not ss2))
(setq ss ss1))
(if (and ss2 (not ss1))
(setq ss ss2))
(if (> (sslength ss) 0)
;;(eval ss)
ss
nil
)
)
(defun gxl-sel-SSgetLineatPoint (pt jd / px py px0 px1 py0 py1 ss pz)
(setq px (car pt)
px0 (- px jd)
px1 (+ px jd)
py (cadr pt)
py0 (- py jd)
py1 (+ py jd)
pz (caddr pt)
)
(setq ss
(ssget "x" (list '(0 . "line")
'(-4 . "<or")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 10 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 10 px1 py1 pz)
'(-4 . "and>")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 11 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 11 px1 py1 pz)
'(-4 . "and>")
'(-4 . "or>")
)
)
)
(if ss(GXL-SEL-REDRAWSEL ss 3))
ss
)
(defun getline (pt jd / s s1 n p1 p2)
(setq s (gxl-sel-SSgetLineatPoint pt jd))
(if s
(progn
(setq s1 (GXL-SEL-SSSUB s ssrtl)
ssrtl (GXL-SEL-SSJOIN ssrtl s1)
)
(if s1
(progn
(setq n 0)
(repeat (sslength s1)
(setq p1 (cdr (assoc 10 (entget (ssname s1 n))))
p2 (cdr (assoc 11 (entget (ssname s1 n))))
)
(getline p2 jd)
(getline p1 jd)
(setq n (1+ n))
)
)
)
)
)
)
;;;程序开始
(princ "\n选择直线：")
(setq enline (car (entsel)))
(initget 5 " ")
(setq jd (getreal "输入容差精度：<0.001>"))
(if (= jd "")(setq jd 0.001))
(setq pt1 (cdr (assoc 10 (entget enline))))
(setq pt2 (cdr (assoc 11 (entget enline))))
(setq ssrtl (ssadd enline))
(getline pt1 jd)
(getline pt2 jd)
ssrtl
)

;;选择直线相连 By Gu_xl 
(defun c:tt(/ gxl-Sel-ReDrawSel gxl-Sel-SSsub gxl-Sel-SSJoin gxl-sel-SSgetLineatPoint getline) 
  (defun gxl-Sel-ReDrawSel (Sel mode / m n) 
    (setq m (sslength Sel) 
   n 0) 
    (repeat m 
(redraw (ssname Sel n) mode) 
(setq n (1+ n)) 
);repeat 
    ) 
  (defun gxl-Sel-SSsub(ss1 ss2 / ss n) 
(cond 
((and ss1 ss2) 
  (setq n 0) 
  (repeat (sslength ss2) 
    (ssdel (ssname ss2 n) ss1) 
    (setq n (1+ n)) 
    ) 
) 
((and ss1 (not ss2)) 
  ss1 
) 
(T 
  (setq ss1 nil) 
) 
) 
ss1 
) 
  (defun gxl-Sel-SSJoin ( ss1 ss2 / ename ss cnt ) 
(if ss1 
(progn 
(if (= (type ss1) 'ENAME) 
(progn 
  (setq 
   ename ss1 
   ss1   (ssadd) 
  ) 
  (ssadd ename ss1) 
)) 
)) 
(if ss2 
(progn 
(if (= (type ss2) 'ENAME) 
(progn 
  (setq 
   ename ss2 
   ss2   (ssadd) 
  ) 
  (ssadd ename ss2) 
)) 
)) 
(setq ss (ssadd)) 
(if (and ss1 ss2) 
(progn 
;(setq ss ss2 cnt 0) 
        (setq  cnt 0) 
        (repeat (sslength ss2) 
  (ssadd (ssname ss2 cnt) ss) 
  (setq cnt (1+ cnt)) 
) 
        (setq  cnt 0) 
(repeat (sslength ss1) 
  (ssadd (ssname ss1 cnt) ss) 
  (setq cnt (1+ cnt)) 
) 
)) 
(if (and ss1 (not ss2)) 
(setq ss ss1)) 
(if (and ss2 (not ss1)) 
(setq ss ss2)) 
(if (> (sslength ss) 0) 
  ;;(eval ss) 
ss 
nil 
) 
) 
  (defun gxl-sel-SSgetLineatPoint (pt jd /  px py px0 px1 py0 py1 ss  pz) 
(setq px (car pt) 
      px0 (- px jd) 
      px1 (+ px jd) 
      py (cadr pt) 
      py0 (- py jd) 
      py1 (+ py jd) 
      pz (caddr pt) 
      ) 
  (setq ss 
(ssget "x" (list '(0 . "line") 
   '(-4 . "<or") 
 
   '(-4 . "<and") 
   '(-4 . ">=,>=,=") 
   (list 10 px0 py0 pz) 
   '(-4 . "<=,<=,=") 
   (list 10 px1 py1 pz) 
   '(-4 . "and>") 
    
   '(-4 . "<and") 
   '(-4 . ">=,>=,=") 
   (list 11 px0 py0 pz) 
   '(-4 . "<=,<=,=") 
   (list 11 px1 py1 pz) 
   '(-4 . "and>") 
    
   '(-4 . "or>") 
   ) 
       ) 
  ) 
  (if ss(GXL-SEL-REDRAWSEL ss 3)) 
  ss 
  ) 
  (defun getline (pt jd / s s1 n p1 p2) 
    
    (setq s (gxl-sel-SSgetLineatPoint pt jd)) 
    (if s 
      (progn 
(setq s1 (GXL-SEL-SSSUB s ssrtl) 
       ssrtl (GXL-SEL-SSJOIN ssrtl s1) 
       ) 
 
(if s1 
   (progn 
     (setq n 0) 
     (repeat (sslength s1) 
       (setq p1 (cdr (assoc 10 (entget (ssname s1 n)))) 
      p2 (cdr (assoc 11 (entget (ssname s1 n)))) 
      ) 
       (getline p2 jd) 
       (getline p1 jd) 
       (setq n (1+ n)) 
       ) 
     ) 
   ) 
) 
      ) 
    
    ) 
  ;;;程序开始 
    (princ "\n选择直线：") 
  (setq enline (car (entsel))) 
  (initget 5 "  ") 
  (setq jd (getreal "输入容差精度：<0.001>")) 
  (if (= jd "")(setq jd 0.001)) 
  (setq pt1 (cdr (assoc 10 (entget enline)))) 
  (setq pt2 (cdr (assoc 11 (entget enline)))) 
(setq ssrtl (ssadd enline)) 
  (getline pt1 jd) 
  (getline pt2 jd) 
  ssrtl 
  )

GTJ116600 · 发表于 2013-8-1 14:37:40

这个主题好，是GIS里面的路径问题。

newer · 发表于 2013-8-1 16:15:01

弄个附图上来啊。

zhang8755 · 发表于 2013-8-1 16:46:36

我有wiika的最短路径的代码，在其基础上改为A星算法，最长还没考虑过。

wowan1314 · 发表于 2013-8-1 18:26:41

zhang8755 发表于 2013-8-1 16:46
我有wiika的最短路径的代码，在其基础上改为A星算法，最长还没考虑过。

不清楚他的代码的意思是否与我这个要求一样。
如果路径都是如上面图一样的支状管网，那么能求最短路径当然也能求最长路径。

wowan1314 · 发表于 2013-8-1 18:28:04

newer 发表于 2013-8-1 16:15
弄个附图上来啊。

附图。其实自己随便画也快。

zhang8755 · 发表于 2013-8-2 12:38:31

wowan1314 发表于 2013-8-1 18:26
不清楚他的代码的意思是否与我这个要求一样。
如果路径都是如上面图一样的支状管网，那么能求最短路径 ...

不一样，求最短路径不用控制重复路径问题。最长路径要过滤一下。

ayl1004 · 发表于 2013-8-2 19:27:53

这个问题还没解决吗？

ayl1004 · 发表于 2013-8-2 19:46:47

那也是，说不定还有更好的思路

newer · 发表于 2013-8-2 19:50:53

哪个是解决的代码？二楼的吗？

wowan1314 · 发表于 2013-8-2 19:53:07

ayl1004 发表于 2013-8-2 19:46
那也是，说不定还有更好的思路

话说你被禁言，我都看不到那些代码。你再发一份都这个论坛吧。
其实解决问题对我是次要的，这个题目我主要是想学习的。

因为我就想到一种方法，结果代码还是你写出来的。

ayl1004 · 发表于 2013-8-2 20:05:09

本帖最后由 ayl1004 于 2013-8-2 22:27 编辑

(defun GetAllPath (SPnt PntLst / PtLst0 PtLst1)
(setq PtLst1 (vl-remove-if-not
(function (lambda (x) (member SPnt x)))
PntLst
) ;_ 所有包含SPnt点的点对表
PtLst0 (vl-remove SPnt (apply 'append PtLst1)) ;_ 和点SPnt相连的所有点
)
(cond
((not SPnt) nil)
;;找到一条线路，停止搜索
((not PtLst0) (list (list SPnt)))
;;核心代码，批量递归
(T
(mapcar
(function (lambda (x) (cons SPnt x)))
(apply
'append
(mapcar
'GetAllPath
PtLst0
;;在PntLst中移除PtLst0点表中点对应的直线，作为第二个参数进入下一步递归运算
(mapcar (function (lambda (x) (vl-remove x PntLst))) PtLst1)
)
)
)
)
)
)

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

[研讨] 求最远路径的问题。。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

评分

[研讨] 求 最 远路径的问题。。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

评分

[研讨] 求最远路径的问题。。