Find route from point to point on a branch of lines

[Jonathan Handojo]

Hi all,

 

I've been struggling on this to no avail, so I thought I'd brought it up here. If this has been asked somewhere, I apologise for not being able to find it.

 

The goal I'm aiming to achieve is to write a function that returns a list of points (in sequence) trailing from one end to another end of a chain of lines. For better clarity, I'm posting this image below:

 

 

What the function should return is the points of the green, yellow, and red circles in order. I'm thinking that the function accepts three arguments (maybe 4 if some flag is required): a selection set, the starting point (green for example), and the ending point (red). I would prefer it if the function can work up to some tolerance (1e-7 perhaps)

 

Here are some things that will always be fixed:

 

1. The selection set are only lines, polylines, or both.

2. The polylines will never have any bulges at any point (even if it does, I'm only interested in the points).

 

So far, this is my attempt, but it's never consistent:

 

;; ss - selection set
;; sp - starting point
;; ep - ending point
;; fl - nil (always nil)

;; LM:intersectionsinset and LM:ss->ent to be loaded

(defun TreePath (ss sp ep fl / cp ips rtn ssl)
    (if (null fl)
	(progn
	    (setq ips (LM:intersectionsinset ss)
		  ssl (mapcar
			  '(lambda (x)
			       (cons x
				     (mapcar 'cdr
					     (vl-remove-if-not
						 '(lambda (y) (member (car y) '(10 11)))
						 (entget x)
						 )
					     )
				     )
			       )
			  (LM:ss->ent ss)
			  )
		  rtn (list (list (caar ssl) (vlax-curve-getClosestPointTo (caar ssl) sp)))
		  )
	    (foreach x (cdr ssl)
		(if (<= (distance sp (setq cp (vlax-curve-getClosestPointTo (car x) sp)))
			(distance (cadar rtn) sp)
			)
		    (setq rtn (list (list (car x) cp)))
		    )
		)
	    (foreach x ssl
		(setq
		    rtn
		       (append
			   rtn
			   (list
			       (cons
				   (car x)
				   (vl-sort
				       (append
					   (cdr x)
					   (vl-remove nil
					       (mapcar
						   '(lambda (y / cp)
							(cond
							    ((or
								 (equal y x)
								 (equal (cadr x) (cadr y) 1e-7)
								 (equal (last x) (cadr y) 1e-7)
								 (equal (cadr x) (last y) 1e-7)
								 (equal (last x) (last y) 1e-7)
								 )
							     nil
							     )
							    ((equal (cadr y) (setq cp (vlax-curve-getClosestPointTo (car x) (cadr y))) 1e-7) cp)
							    ((equal (last y) (setq cp (vlax-curve-getClosestPointTo (car x) (last y))) 1e-7) cp)
							    )
							)
						   ssl
						   )
					       )
					   )
				       '(lambda (a b)
					    (<
						(vlax-curve-getParamAtPoint (car x) a)
						(vlax-curve-getParamAtPoint (car x) b)
						)
					    )
				       )
				   )
			       )
			   )
		    )
		)
	    (TreePath nil nil ep rtn)
	    )
	(vl-some
	    '(lambda (x / c)
		 (cond
		     ((vl-some
			  '(lambda (y / m r)
			       (cond
				   ((equal y ep 1e-7) (list ep))
				   ((null (cdr fl)) nil)
				   ((setq m (TreePath nil nil ep (cdr fl)))
				    (cons y m)
				    )
				   )
			       )
			  (cdr x)
			  )
		      )
		     )
		 )
	    fl
	    )
	)
    )

 

I'd appreciate any help... Thanks.

 

 

 

[BIGAL]

Has been done before, think of your car GPS at top level. If you get correct google search you will find, start with "shortest path"

[ronjonp]

See HERE. It uses dijkstra algorithm that YMG converted to lisp.

[Jonathan Handojo]

Thanks guys. By looking at Ron's post, I was able to modify the function to suit my needs. But that certainly was a very brilliant approach, and without it, I wouldn't have been able to get there.

 

Just to share the function if anyone needs it (and a couple bit of rectifications as well from original code in order to escape the while loop if the nodes are non-existing in the list of points:

 

;;; TreePath
;;; Attempts to find the shortest route from one point to another through a network of nodes
;;; (similar to every turn/signal from that of a car GPS)
;;; With thanks to ronjonp & ymg from "TheSwamp" for ideas to help out:
;;; http://www.theswamp.org/index.php?topic=45092.45
;;; 
;;; lst - a list of lists where each sublist is a list of two points between each node to calculate
;;; sp - starting point
;;; ep - ending point
;;;
;;; Returns a list of points denoting the shortest distance reaching from SP to EP.
;;; If SP or EP is not found within the list of nodes, returns nil (as opposed to an endless loop).

(defun TreePath (lst sp ep / cl op rtn)
    (setq op (list (list sp sp)) go t)
    (while (and op (not (equal (caar cl) ep 1e-7)))
	(setq cl (cons (car op) cl) op (cdr op))
	(mapcar
	    (function
		(lambda (a / c s)
		    (if
			(cond
			    ((equal (caar cl) (car a) 1e-7)
			     (setq c (cadr a))
			     )
			    ((equal (caar cl) (cadr a) 1e-7)
			     (setq c (car a))
			     )
			    )
			(progn
			    (cond
				((vl-some '(lambda (z) (equal z c 1e-7)) (mapcar 'car cl)))
				((progn
				     (setq op
					      (mapcar
						  '(lambda (ss)
						       (if (and (equal c a 1e-7)
								(< (distance c (cadr ss))
								   (apply 'distance a)
								   )
								)
							   (progn (setq s t) c)
							   ss
							   )
						       )
						  op
						  )
					   )
				     s
				     )
				 )
				(t (setq op (cons (list c (caar cl)) op)))
				)
			    (setq lst (vl-remove-if '(lambda (x) (equal a x 1e-7)) lst))
			    )
			)
		    )
		)
	    lst
	    )
	(setq op (vl-sort op '(lambda (a b) (< (apply 'distance a) (apply 'distance b)))))
	)
    (if (equal (caar cl) ep 1e-7)
	(progn
	    (setq rtn (list (caar cl)))
	    (foreach x cl
		(if
		    (and
			(equal (car rtn) (car x))
			(not (apply 'equal (append x '(1e-7))))
			)
		    (setq rtn (cons (cadr x) rtn))
		    )
		)
	    rtn
	    )
	)
    )

 

[ronjonp]

Nice job @Jonathan Handojo  .. I did a quick test and it looks like you have a bug. The green route is shorter.

(defun c:foo (/ a p r)
  (foreach e (mapcar 'cadr (ssnamex (ssget "_X" '((0 . "line")))))
    (setq p (cons (list (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e)))) p))
  )
  (setq r (treepath p (getpoint) (getpoint)))
  (setq a 0)
  (mapcar '(lambda (r j) (setq a (+ a (distance r j))) (grdraw r j 1)) r (cdr r))
  (print a)
)

 

test.dwg

Edited February 1, 2021 by ronjonp

[siimao]

Hi, solution nice!

Is it possible to adopt function to deel with line not only with them endpoints (cdr (assoc 10 and (cdr (assoc 11  but with them interseption points too?

Thank you very much in advance.

Edited October 18, 2023 by siimao