取得两点间的路由程序...

舟自横

听说取得两点间的路由比较困难.. 我看了前面的文章好象没有谁能拿出解决的办法来 我试写了一个..也不觉得很困难啊.. 里面用到了AP-API函数可以从网上下载 [PHP]
(defun c:hy_roadway(/ layer sst point1 point2 key p1 PX ssty)
(setvar "cmdecho" 0)
(setvar "osmode" 1)
(setq layer (getvar "clayer"))
(command "undo" "be")
(setq sst '())
(setq point1 (getpoint "\n请选择路由点1:"))
(while (not (hy_roadway_1 point1))
(setq point1 (getpoint "\n起点无实体重新选路由点1:"))
)
(setq point2 (getpoint "\n请选择路由点2:"))
(while (not (hy_roadway_1 point2))
(setq point2 (getpoint "\n终点无实体重新选路由点2:"))
)
(setvar "osmode" 0)
(setq key nil)
(setq ent nil)
(setq p1 nil)
(WHILE (not key)
(if (hy_roadway_1 point1)
(progn
(hy_aplinexx (ssname (hy_roadway_1 point1) 0))
(setq pa (vlax-curve-getendpoint (vlax-ename->vla-object (entlast))))
(setq pb (vlax-curve-getstartpoint (vlax-ename->vla-object (entlast))))
(if (not (equal pa point1 0.0001))
(setq px pa) (setq px pb))
(if (equal px point2 0.0001)
(progn
(setq ent (entlast))
(SETQ SST (hy_polyss ENT))
(setq key t)
;(hy_roadway_3 (entlast))
)
(hy_roadway_3 (entlast))
)
)
(setq key t)
)
)

(command "undo" "e")
(command "undo" 1)
(if ent
(progn
(setq io 0)
(setq ssty (ssadd))
(REPEAT (LENGTH SST)
(ENTMAKE (nth io sst))
(command "change" (entlast) "" "p" "color" 1 "")
(setq ssty (ssadd (entlast) ssty))
(setq io (1+ io))
)
(command "pedit" "m" ssty "" "y" "j" 0.0001 "" )
)
(alert "\n此两点间无路由!")
)
(prin1)
) (defun hy_roadway_1(point / pt1 ss)
(setq pt1 (polar point 0.8 0.01))
(setq ss (ssget "c" point pt1))
ss
)
(defun hy_roadway_2(en / endata enlist)
(setq endata (entget en))
(setq enlist (member (assoc 10 endata) endata))
(setq enlist (append (list '(0 . "LWPOLYLINE")(cons 8 layer)) enlist))
enlist
)
(defun hy_roadway_3(en / pt1 pt2 ssg)
(command "._explode" en)
(setq ssg (hy_roadway_1 px))
(command "._erase" ssg "")
)
(defun hy_aplinexx(ename1 / vla-obj tux endpoint ename startpoint i ss1 ss5
ss7 ss6 nn ssm ssn itemx);;;选择一条线串接与之相联的图元为多义线
(setvar "osmode" 0)
(if (= "LWPOLYLINE" (cdr(assoc 0 (entget ename1))))
(progn (command "._explode" ename1)
(setq ename (entlast)))
(setq ename ename1)
)
(setq vla-obj (vlax-ename->vla-object ename))
(setq startpoint (vlax-curve-getstartpoint vla-obj)
endpoint (vlax-curve-getendpoint vla-obj))
(setq j 0);;计数器归0
(setq nn 0)
(princ " ─── \r")
(while (> (distance startpoint endpoint) 0.0000001);(= (vla-get-closed vla-obj) :vlax-false)
(setq ss5 (ssget "C" startpoint (polar startpoint 0.8 0.01)))
(setq ss6 (ssget "C" endpoint (polar endpoint 0.8 0.01)))
(setq ss7 (addss ss5 ss6))
(setq ss7 (ssdel ename ss7))
(setq tux 0)
(repeat (sslength ss7)
(setq ento (entget (ssname ss7 tux)))
(if (and (not (member (list 10 (car startpoint)(cadr startpoint))
ento))
(not (member (list 10 (car endpoint)(cadr endpoint))
ento))
)
(COND ((vlax-curve-getparamatpoint
(vlax-ename->vla-object(ssname ss7 tux)) startpoint)
(command "._break" (ssname ss7 tux) startpoint startpoint))
((vlax-curve-getparamatpoint
(vlax-ename->vla-object(ssname ss7 tux)) endpoint)
(command "._break" (ssname ss7 tux) endpoint endpoint)
)
)
(if (= "LWPOLYLINE" (cdr(assoc 0 ento)))
(command "._explode" (ssname ss7 tux)))
)
(setq tux (1+ tux))
)
(setq ss1 (ssget "C" startpoint (polar startpoint 0.8 0.01)))
(setq ss2 (ssget "C" endpoint (polar endpoint 0.8 0.01)))
(setq ss1 (addss ss1 ss2))
(if (= "LWPOLYLINE" (cdr(assoc 0 (entget ename))))
(command "pedit" ename "j" ss1 "" "")
(command "pedit" ename "y" "j" ss1 "" "")
)
(setq ename (entlast))
(setq vla-obj (vlax-ename->vla-object ename))
(setq startpoint (vlax-curve-getstartpoint vla-obj)
endpoint (vlax-curve-getendpoint vla-obj))
(setq nn (1+ nn))
(cond ((= nn 15)(princ (strcat "线很长..正在串接中,请稍侯 ...... ───" "\r")))
((= nn 30)(princ (strcat "线很长..正在串接中,请稍侯 ...... ﹨﹨﹨" "\r")))
((= nn 45)(princ (strcat "线很长..正在串接中,请稍侯 ...... │││" "\r")))
((= nn 60)(princ (strcat "线很长..正在串接中,请稍侯 ...... ∕∕∕" "\r")))
)
(if (> nn 60) (setq nn 1))
(setq j (1+ j))
(IF (= 1 (sslength ss1))
(setq startpoint '(0 0 0) endpoint '(0 0 0)));(alert "\n请注意!****串接不线不能封闭!")
)
(if (> j 1000)(princ (strcat "\n恭喜你一共把" (itoa (+ (* 2 j) 3)) "条线串接成了一个封闭的復线!")))
)
(defun addss(ss1 ss2 / i );;;将一个选择集的内容加入另一个,合并选择集
(setq i 0)
(repeat (sslength ss1)
(setq ss2 (ssadd (ssname ss1 i) ss2))
(setq i (1+ i))
)
(setq ssg ss2)
) (defun hy_polyss(en / i polist po1 po2 imfor1 centers radi stang edang list1);;该程序实现将復线中所包含的图元信息加入列表方便以后用ENTMAKE重新建立图元
(setq polist (ap-polyline-vblist en))
(setq i 0)
(setq elist '())
(repeat (- (length polist) 1)
;(setq list1 '())
(setq po1 (nth i polist))
(setq po2 (nth (1+ i) polist))
(setq imfor1 (ap-polyline-segment po1 po2))
(if (ap-item 'CENTER imfor1)(progn (setq centers (cons 10 (ap-item 'CENTER imfor1))
radi (cons 40 (ap-item 'RADIUS imfor1)))
(if (< (ap-item 'INCLUDED-ANG imfor1) 0)
(setq stang (cons 50 (ap-item 'END-ANG imfor1))
edang (cons 51 (ap-item 'START-ANG imfor1)))
(setq stang (cons 51 (ap-item 'END-ANG imfor1))
edang (cons 50 (ap-item 'START-ANG imfor1)))
)
(setq list1 (list (CONS 0 "ARC") centers radi stang edang))
(setq elist (cons list1 elist))
)
(progn (setq p1 (cons 10 (car po1)) p2 (cons 11 (car po2)))
(setq list1 (list (CONS 0 "LINE") p1 p2))
(setq elist (cons list1 elist))
)
)
(setq i (1+ i))
)
(setq elist (reverse elist))
)
[/PHP]

ljpnb

舟兄，你的程序你测试正常啊？？？不要说你测试的图形是比较简单的那种。

舟自横

我测试了多种情况尚可..不过可能还会有点


不完善的地方..我也是匆匆写了就传上来了..要不.你


也帮忙测试一下...自己写的自己测试总会形成思维定势的


...

spshchen

让我大开眼界,让我知道AP-API-AutoLISP函数集,也把我想写的东西写出来了,谢谢楼主的奉献,方便的话 和我联系,一起沟通,QQ156558475,我还要对你的函数好好研究一下.

spshchen

我测试了一下 程序没有办法取线的交点,只能是各条线的起点和终点,


因此 我在学楼主的思路,对所有的线都打断,最后恢复,我先写一下,看看

spshchen

最新测试结果,有一个有路由,无法得到,


还有个问题有2种路由的 情况无法找到最短路由.

舟自横

这正是我在考虑的地方...


等有时间在休整一下看..


其实我自己试了一下也发现了一些


BUG,这个程序不是很完美..再改改看吧..

spshchen

不过 我是把交点作为多段线的顶点,得到所有点和点之间的关系,再根据查表得到结果,真想把这个表保存到MDB里面 用SQL去查询. 不过我做的自己都拿不出手 写了很多,还有坐标比较的精度,处理起来感觉比较麻烦,而且我还没有找到多曲线的处理的方法, 希望 舟兄弟早点 拿出好的程序.