Message 1 of 2
quickest route between 2 points
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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)
)