[LISP函数]：取得两点间的路由程序

舟自横

我看到以前的几个文章
一直以来路由程序是一个难点..
好象没有谁写出来过...
呵呵...经过我的一番琢磨...觉得并不是
很难..看..
[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]

啵浪鼓

上面的程序用来做什么的，选择物体会出错。。。
如果选择矩形会删掉2条形

Command: HY_ROADWAY
請選擇路由點1:
; error: no function definition: HY_POLYSS

舟自横

呵呵....不是来选这个的...是别人铁路上用的..看了几个
网站好象没人写出来..我就写拉..作用是:
比如一个点上有很多个线与他相通,然后与他相
通的线的另外一个端点又有很多个分支..如此下去
...就会形成错综复杂的网..然后我找出其中任意两个
端点
然后要求用程序找出通过这两点的连线...
就相当于我如何才能从一点走到另一点的通道...
不过程序刚写好可能还有点不完善的地方..
先传上来玩玩...大致上已经可以用了...

啵浪鼓

有没有删除比如多余线段的程序，我以前有个删除多余线并创建聚合线，但程序太大，有没有更于简单点的先删除圆和线段里存在的多余线再创建聚合线

下段为聚合线的程序，无删除复线
(DEFUN C:ER (/ Pp p3 cn)                                ;pedit polyline
(setq cn 0)
(initget 0)
(SETQ Pp (SSGET '(       (-4 . "<OR")
                         (0 . "LWPOLYLINE")
                         (0 . "ARC")
                         (0 . "LINE")
                         (-4 . "OR>")
)))
(repeat (sslength pp)
(SETQ Pp (SSGET "p"))
(if pp(if (< cn (sslength pp))
(progn(setq P1 (SSNAME  Pp cn))
(IF (=(logand(if(CDR(ASSOC 70(ENTGET(SSNAME Pp cn))))
(CDR(ASSOC 70(ENTGET(SSNAME Pp cn)))) 0)1) 1)
(setq cn (1+ cn))
(IF (= (CDR (ASSOC 0 (ENTGET (SSNAME Pp cn)))) "LWPOLYLINE")
(COMMAND "PEDIT" P1 "J" Pp "" "")
(COMMAND "PEDIT" P1 "" "J" Pp "" "")))))))
(PRinc "\nAll right!")
(PRINC)
)

舟自横

不就是删除重复线功能吗??大把...
不过今天不想传了还要去开我的电脑.
明天传...

啵浪鼓

发。。。

狂刀

请继续调试:
最好能传个测试图上来


請選擇路由點1:
請選擇路由點2: ───
错误: no function definition: HY_POLYSS

命令:  TT
請選擇路由點1:
請選擇路由點2: ───

*无效选择*
需要点或
窗口(W)/上一个(L)/窗交(C)/框(BOX)/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)/类
(CL)

错误: 函数被取消


*无效选择*
需要点或
窗口(W)/上一个(L)/窗交(C)/框(BOX)/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)/类
(CL)


*无效选择*
需要点或
窗口(W)/上一个(L)/窗交(C)/框(BOX)/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)/类
(CL)


*无效选择*
需要点或
窗口(W)/上一个(L)/窗交(C)/框(BOX)/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)/类
(CL)

选择对象: 指定对角点: 找到 1 个

选择对象:

舟自横

不好意思漏上了一个子程序..
已经编辑过...

啵浪鼓

你现在还在加班还是在家里上网啊？

spshchen

楼主厉害,我找了好多时间和写了不少程序,还一直由BUG,而且还没有把曲线考虑进去,
,我看到 你把好多线断了 还炸开,我感觉没有必要可以用点集,因为这样破坏了原来的图,由点最后生成路由,,不过 我还得好好的看看你的程序.

舟自横

楼上的回答你一个问题...
我并没有破坏原图..你没看见
最后有UNDO了吗?已经恢复到计算前状态
只是把路由的信息提了出来多画了条红色
的路由线而已..
请注意要将AP-API一起加载

spshchen

好思路,不过还有个功能就是: 不能选择线的交点(交点并不是线的顶点.
还是我操作的问题