quickest route between 2 points

quickest route between 2 points

rpajounia
Advocate Advocate
271 Views
1 Reply
Message 1 of 2

quickest route between 2 points

rpajounia
Advocate
Advocate

If i wanted to get from point 1 to point 2 and i wanted to only use the lines in the drawing how can i make a code that will get me from point 1 to point 2, for example go from x,y point to x,y point to x,y point to x,y point?

 

Code below works great for lines but how do i get it to work with polylines?

 

; Find the path of minimum total length between two given nodes g and f.      ;
; Using Dijkstra Algorithm                                                    ;
;                                                                             ;
; See http://tech-algorithm.com/articles/dijkstra-algorithm/                  ;
;                                                                             ;
; Written by ymg   August 2013                                                ;
 
(defun minpath ( g f nodes edges / brname clnodes closedl dst1 dst2 m minpath minpathn mp new nodname old oldpos openl totdist )
  (setq nodes   (vl-remove g nodes)
        openl   (list (list g 0 nil))
        closedl nil
  )
  (foreach n nodes
    (setq nodes (subst (list n 0 nil) n nodes))
  )
  (while (not (equal (caar closedl) f 1e-6))
    (setq nodname (caar openl)
          totdist (cadar openl)
          closedl (cons (car openl) closedl)
          openl   (cdr openl)
          clnodes (mapcar 'car closedl)
 
    )
    (foreach e edges
      (setq brname nil)
      (if (equal (car e) nodname 1e-6)
        (setq brname (cadr e))
      )
      (if (equal (cadr e) nodname 1e-6)
        (setq brname (car e))
      )
 
      (if brname
        (progn
          (setq new (list brname (+ (caddr e) totdist) nodname))
          (cond
            ((member brname clnodes))
            ((setq oldpos (vl-position brname (mapcar 'car openl)))
             (setq old (nth oldpos openl))
             (if (< (cadr new) (cadr old))
               (setq openl (subst new old openl))
             )
            )
            (t (setq openl (cons new openl)))
          )
          (setq edges (vl-remove e edges))
        )
      )
    )
    (setq
      openl (vl-sort openl
                     (function (lambda (a b) (< (cadr a) (cadr b))))
            )
    )
  )
  (setq minpath (list (list (car closedl))))
  (setq dst1 (cadr (car closedl)))
  (setq m 1)
  (foreach k closedl
    (setq dst2 (cadr k))
    (if (not (equal dst1 dst2 1e-6)) (setq m (1+ m) dst1 dst2))
  )
  (repeat m
    (foreach n closedl
      (if (= (length minpath) 1)
        (if (equal (car n) (caddr (caar minpath)) 1e-6) (setq mp (cons n mp)))
        (mapcar '(lambda (x) (if (equal (car n) (caddr (car x)) 1e-6) (setq mp (cons n mp)))) minpath)
      )
    )
    (setq mp (vl-sort mp '(lambda (a b) (not (equal (car b) (car a) 1e-6)))))
    (if (= (length minpath) 1)
      (setq minpath (mapcar '(lambda (x) (cons x (car minpath))) mp))
      (setq minpath (mapcar '(lambda (x) (mapcar '(lambda (y) (if (equal (car x) (caddr (car y)) 1e-6) (cons x y))) minpath)) mp))
    )
    (setq minpath (mapcar '(lambda (x) (vl-remove nil x)) minpath))
    (if (listp (caaaar minpath)) (setq minpath (apply 'append minpath)))
    (mapcar '(lambda (x) (if (eq (caddr (car x)) nil) (setq minpathn (cons x minpathn)))) minpath)
    (setq mp nil)
  )
  (setq minpathn (acet-list-remove-duplicates minpathn nil))
  (setq minpathn (vl-remove nil minpathn))
)
 
(defun make3dpl ( ptlst )
  (entmake 
    (list
      '(0 . "POLYLINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDb3dPolyline")
      '(66 . 1)
      '(62 . 3)
      '(10 0.0 0.0 0.0)
      '(70 . 8)
      '(210 0.0 0.0 1.0)
    )
  )
  (foreach pt ptlst
    (entmake
      (list
        '(0 . "VERTEX")
        '(100 . "AcDbEntity")
        '(100 . "AcDbVertex")
        '(100 . "AcDb3dPolylineVertex")
        (cons 10 pt)
        '(70 . 32)
      )
    )
  )
  (entmake
    (list
      '(0 . "SEQEND")
      '(100 . "AcDbEntity")
    )
  )
)
 
(defun c:shortlinespath ( / osm ss i lin p1 p2 linlst ptlst g f dijkstra ptlstpths pl )
  (vl-load-com)
  (setq osm (getvar 'osmode))
  (setq ss (ssget "_:L" '((0 . "LINE"))))
  (setq i -1)
  (while (setq lin (ssname ss (setq i (1+ i))))
    (setq p1 (cdr (assoc 10 (entget lin)))
          p2 (cdr (assoc 11 (entget lin)))
    )
    (setq linlst (cons (list p1 p2 (distance p1 p2)) linlst))
    (setq ptlst (cons p1 ptlst) ptlst (cons p2 ptlst))
  )
  (setq ptlst (acet-list-remove-duplicates ptlst 1e-6))
  (setvar 'osmode 1)
  (setq g (getpoint "\nPick starting point on LINES NETWORK : ")
        f (getpoint "\nPick ending point on LINES NETWORK : ")
  )
  (setq dijkstra (minpath g f ptlst linlst))
  (setq ptlstpths (mapcar '(lambda (x) (mapcar 'car x)) dijkstra))
  (mapcar '(lambda (x) (make3dpl x)) ptlstpths)
  (prompt "\nShortest path length is : ") (princ (rtos (setq len (cadr (last (car dijkstra)))))) (prompt " - you should check length to match data")
  (setq ss (ssget "_X" (list '(0 . "POLYLINE") '(70 . 😎 (cons 8 (getvar 'clayer)))))
  (setq i -1)
  (while (setq pl (ssname ss (setq i (1+ i))))
    (if (not (equal (vla-get-length (vlax-ename->vla-object pl)) len 1e-6)) (entdel pl))
  )
  (setvar 'osmode osm)
  (textscr)
  (princ)
)
0 Likes
272 Views
1 Reply
Reply (1)
Message 2 of 2

ronjonp
Mentor
Mentor

@rpajounia Take a look HERE. It's a start for you.

0 Likes