Topic: find distance between points on multiple connected lines

[jjurkus]

Let's say we have a few lines and polylines connected to each others start- and endpoints. These objects form one continuous line, but are not a single polyline.
I would like to find the distance between two points on these objects. These points are intersections with other objects. So I would like to know the distance from one intersection to the next intersection, but only via those connected objects.
The connected objects are on the same layer.

I'm thinking of implementing this algorithm, but I'm wondering if anybody has a better idea.
At first I need one of the connecting objects, this is coming from a different function, which gives the intersectionpoints.
I would make a selectionset on one intersectionpoint -> this is probably an object in the middle of the connecting lines.
Then the start and endpoints of this object will be asked (vlax-get-property object 'StartPoint). Of course polylines do not have this property, so there is some extra coding to be done there.
On the startpoint and endpoint I would make a similar selectionset, on one point. The previous object will be removed from the selectionset.
If there are no objects found this previous object is the beginning or the end of the connecting lines.
If there are multiple objects found we check if they have their startpoint or endpoint on the same point as the point where we made the selectionset. (which is the start-/endpoint of the previous object). We have to check if there are multiple objects returned with a startpoint, because then something is amiss.
Meanwhile, we have written the first object to a list. Objects that are connected to the startpoint get placed in front of the list, and objects that are connected to the endpoint are placed on the end of the list. Thus we will have a list with vla-objects in the correct order.

All the objects in the list will be checked if they have a intersection. Objects between the two intersections will be asked for their length.
The intersectionobjects then will need to be asked their getDistAtPoint.... and I somehow have to find out if the distance needed is the one from the endpoint or from the startpoint.
Then I can add all these lengths and finally have the result that I need.

This all seems a bit difficult. So I'm hoping someone has a better idea! 

[ronjonp]

You could use Lee's chain selection: http://www.lee-mac.com/chainsel.html
Then for each object use a function like so:

Code - Auto/Visual Lisp: [Select]

1. (defun _getlength (ename / ep)
2.   (if (vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
3.     0.0
4.     (vlax-curve-getdistatparam ename ep)
5.   )
6. )

[Lee Mac]

You could use Lee's chain selection: http://www.lee-mac.com/chainsel.html

Many thanks Ron - I was just about to suggest that 

[ronjonp]

You could use Lee's chain selection: http://www.lee-mac.com/chainsel.html

Many thanks Ron - I was just about to suggest that 

   

[jjurkus]

You could use Lee's chain selection: http://www.lee-mac.com/chainsel.html

Thanks!!! 
This might be what I need. I'll keep you updated.

[Lee Mac]

This looked to be an interesting challenge, and so below is my first draft at a possible solution:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / len lst pt1 pt2 sel tmp )
2.     (if
3.         (and
4.             (setq sel
5.                 (ssget
6.                     (list
7.                        '(-4 . "<OR")
8.                            '(0 . "LINE,ARC")
9.                            '(-4 . "<AND")
10.                                '(0 . "LWPOLYLINE,SPLINE")
11.                                '(-4 . "<NOT")
12.                                    '(-4 . "&=")
13.                                    '(70 . 1)
14.                                '(-4 . "NOT>")
15.                            '(-4 . "AND>")
16.                            '(-4 . "<AND")
17.                                '(0 . "POLYLINE")
18.                                '(-4 . "<NOT")
19.                                    '(-4 . "&")
20.                                    '(70 . 89)
21.                                '(-4 . "NOT>")
22.                                '(-4 . "AND>")
23.                            '(-4 . "<AND")
24.                                '(0 . "ELLIPSE")
25.                                '(-4 . "<OR")
26.                                    '(-4 . "<>")
27.                                    '(41 . 0.0)
28.                                    '(-4 . "<>")
29.                                     (cons 42 (+ pi pi))
30.                                '(-4 . "OR>")
31.                            '(-4 . "AND>")
32.                        '(-4 . "OR>")
33.                         (if (= 1 (getvar 'cvport))
34.                             (cons 410 (getvar 'ctab))
35.                            '(410 . "Model")
36.                         )
37.                     )
38.                 )
39.             )
40.             (setq pt1 (getpoint "\n1st point: "))
41.             (setq pt2 (getpoint "\n2nd point: "))
42.         )
43.         (if
44.             (setq tmp
45.                 (vl-member-if
46.                     (function
47.                         (lambda ( itm / tmp )
48.                             (cond
49.                                 (   (equal pt1 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt1)) 1e-3)
50.                                     (setq  pt1 tmp)
51.                                 )
52.                                 (   (equal pt2 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt2)) 1e-3)
53.                                     (mapcar 'set '(pt1 pt2) (list tmp pt1))
54.                                 )
55.                             )
56.                         )
57.                     )
58.                     (LM:sortedchainselection sel)
59.                 )
60.                 lst
61.                 (vl-member-if
62.                     (function
63.                         (lambda ( itm / tmp )
64.                             (if (equal pt2 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt2)) 1e-3)
65.                                 (setq  pt2 tmp)
66.                             )
67.                         )
68.                     )
69.                     (reverse (cdr tmp))
70.                 )
71.             )
72.             (progn
73.                 (setq len
74.                     (+
75.                         (abs
76.                             (- (vlax-curve-getdistatpoint (cadar tmp) pt1)
77.                                (vlax-curve-getdistatpoint (cadar tmp) (caddar tmp))
78.                             )
79.                         )
80.                         (abs
81.                             (- (vlax-curve-getdistatpoint (cadar lst) pt2)
82.                                (vlax-curve-getdistatpoint (cadar lst) (caar lst))
83.                             )
84.                         )
85.                     )
86.                 )
87.                 (foreach itm (cdr lst)
88.                     (setq len (+ len (vlax-curve-getdistatparam (cadr itm) (vlax-curve-getendparam (cadr itm)))))
89.                 )
90.                 (princ (strcat "\nLength: " (rtos len)))
91.             )
92.             (princ "\nThe selected points do not lie on the same chain.")
93.         )
94.     )
95.     (princ)
96. )
97.  
98. (defun LM:sortedchainselection ( sel / end ent flg idx lst rtn tmp )
99.     (repeat (setq idx (sslength sel))
100.         (setq ent (ssname sel (setq idx (1- idx)))
101.               lst (cons (list (vlax-curve-getstartpoint ent) ent (vlax-curve-getendpoint ent)) lst)
102.         )
103.     )
104.     (setq end (list (caar lst) (caddar lst))
105.           rtn (list (car lst))
106.           lst (cdr lst)
107.     )
108.     (while
109.         (progn
110.             (foreach itm lst
111.                 (cond
112.                     (   (equal (car itm) (car end) 1e-8)
113.                         (setq end (cons (caddr itm) (cdr end))
114.                               rtn (cons (reverse itm) rtn)
115.                               flg t
116.                         )
117.                     )
118.                     (   (equal (car itm) (cadr end) 1e-8)
119.                         (setq end (list (car end) (caddr itm))
120.                               rtn (append rtn (list itm))
121.                               flg t
122.                         )
123.                     )
124.                     (   (equal (caddr itm) (car end) 1e-8)
125.                         (setq end (cons (car itm) (cdr end))
126.                               rtn (cons itm rtn)
127.                               flg t
128.                         )
129.                     )
130.                     (   (equal (caddr itm) (cadr end) 1e-8)
131.                         (setq end (list (car end) (car itm))
132.                               rtn (append rtn (list (reverse itm)))
133.                               flg t
134.                         )
135.                     )
136.                     (   (setq tmp (cons itm tmp)))
137.                 )
138.             )
139.             flg
140.         )
141.         (setq lst tmp tmp nil flg nil)
142.     )
143.     rtn
144. )
145.  
146. (vl-load-com) (princ)

The above is obviously only an example - the selection set & points could of course be obtained without user input if necessary.

A quick demo:



« EDIT: Changed caddar to caar on line 82 »

[jjurkus]

Yes, I figured something like that, to sort the matching points.

Code: [Select]

(if (= 1 (getvar 'cvport))
    (cons 410 (getvar 'ctab))
    '(410 . "Model")
)

What does this do? In modelspace the cvport is 2. However (cons 410 (getvar 'ctab)) also evaluates to (410 . "Model"), so I'm wondering why this is in there.

[Lee Mac]

Code: [Select]

(if (= 1 (getvar 'cvport))
    (cons 410 (getvar 'ctab))
    '(410 . "Model")
)
What does this do? In modelspace the cvport is 2. However (cons 410 (getvar 'ctab)) also evaluates to (410 . "Model"), so I'm wondering why this is in there.

Consider the case of viewing Modelspace through a Paperspace viewport.

[jjurkus]

Consider the case of viewing Modelspace through a Paperspace viewport.

*cricket sounds*

Uhh, I don't even know how to make a viewport. The funny thing is that I'm not someone who has worked a lot with autocad, or any cad program. I'm not even a programmer! I just 'work' here, and inherited a few things that weren't working very well (or at all).
This previous guy made programs that only worked on his computer. 
His logic was fine: Let's use this layer! Now, let's check if this layer even exists!     

Anyway, there's still something else I don't understand, but will ask later, if I don't understand it in a few days.

[jjurkus]

This looked to be an interesting challenge, and so below is my first draft at a possible solution:

I've found a case where your code gives incorrect results.
In the attached dwg file I measured from the ends of the connecting lines. This gives about 5000. Measuring somewhere in between gives about 8000. This is of course incorrect, as a longer line should give a longer length. (captain obvious)
Measuring from 'top left' to 'bottom right' gives 1328, which is the length of the diagonal line. So, I think the upper polyline is measured from the wrong side.
Measuring form 'bottom left' to 'top right' gives a 'The selected points do not lie on the same chain.'

The left image gives the same results, which is drawn the same, except for the top polyline. This has been reversed. I thought they might give different results, but they don't.

[Lee Mac]

Thank you for bringing this to my attention, I have now corrected the above code.

[ribarm]

Thanks, Lee... I've added option if picked points lie on the same entity - you can select complete chain or just that entity...

Code: [Select]

(defun c:ssp1p2curveslength ( / len lst pt1 pt2 sel tmp ) (vl-load-com)
    (if
        (and
            (setq sel
                (ssget
                    (list
                       '(-4 . "<OR")
                           '(0 . "LINE,ARC")
                           '(-4 . "<AND")
                               '(0 . "LWPOLYLINE,SPLINE")
                               '(-4 . "<NOT")
                                   '(-4 . "&=")
                                   '(70 . 1)
                               '(-4 . "NOT>")
                           '(-4 . "AND>")
                           '(-4 . "<AND")
                               '(0 . "POLYLINE")
                               '(-4 . "<NOT")
                                   '(-4 . "&")
                                   '(70 . 89)
                               '(-4 . "NOT>")
                               '(-4 . "AND>")
                           '(-4 . "<AND")
                               '(0 . "ELLIPSE")
                               '(-4 . "<OR")
                                   '(-4 . "<>")
                                   '(41 . 0.0)
                                   '(-4 . "<>")
                                    (cons 42 (+ pi pi))
                               '(-4 . "OR>")
                           '(-4 . "AND>")
                       '(-4 . "OR>")
                        (if (= 1 (getvar 'cvport))
                            (cons 410 (getvar 'ctab))
                           '(410 . "Model")
                        )
                    )
                )
            )
            (setq pt1 (getpoint "\n1st point: "))
            (setq pt2 (getpoint "\n2nd point: "))
        )
        (if
            (setq tmp
                (vl-member-if
                    (function
                        (lambda ( itm / tmp )
                            (cond
                                (   (equal pt1 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt1)) 1e-3)
                                    (setq  pt1 tmp)
                                )
                                (   (equal pt2 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt2)) 1e-3)
                                    (mapcar 'set '(pt1 pt2) (list tmp pt1))
                                )
                            )
                        )
                    )
                    (LM:sortedchainselection sel)
                )
                lst
                (vl-member-if
                    (function
                        (lambda ( itm / tmp )
                            (if (equal pt2 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt2)) 1e-3)
                                (setq  pt2 tmp)
                            )
                        )
                    )
                    (reverse tmp)
                )
            )
            (progn
                (if (= (length lst) 1)
                    (setq len
                        (abs
                            (-
                               (abs
                                   (- (vlax-curve-getdistatpoint (cadar tmp) pt1)
                                      (vlax-curve-getdistatpoint (cadar tmp) (caddar tmp))
                                   )
                               )
                               (abs
                                   (- (vlax-curve-getdistatpoint (cadar lst) pt2)
                                      (vlax-curve-getdistatpoint (cadar lst) (caddar lst))
                                   )
                               )
                            )
                         )
                    )
                    (setq len
                        (+
                            (abs
                                (- (vlax-curve-getdistatpoint (cadar tmp) pt1)
                                   (vlax-curve-getdistatpoint (cadar tmp) (caddar tmp))
                                )
                            )
                            (abs
                                (- (vlax-curve-getdistatpoint (cadar lst) pt2)
                                   (vlax-curve-getdistatpoint (cadar lst) (caar lst))
                                )
                            )
                        )
                    )
                )
                (foreach itm (cdr (reverse (cdr lst)))
                    (setq len (+ len (vlax-curve-getdistatparam (cadr itm) (vlax-curve-getendparam (cadr itm)))))
                )
                (princ (strcat "\nLength: " (rtos len)))
            )
            (princ "\nThe selected points do not lie on the same chain.")
        )
    )
    (princ)
)
 
(defun LM:sortedchainselection ( sel / end ent flg idx lst rtn tmp ) (vl-load-com)
    (repeat (setq idx (sslength sel))
        (setq ent (ssname sel (setq idx (1- idx)))
              lst (cons (list (vlax-curve-getstartpoint ent) ent (vlax-curve-getendpoint ent)) lst)
        )
    )
    (setq end (list (caar lst) (caddar lst))
          rtn (list (car lst))
          lst (cdr lst)
    )
    (while
        (progn
            (foreach itm lst
                (cond
                    (   (equal (car itm) (car end) 1e-8)
                        (setq end (cons (caddr itm) (cdr end))
                              rtn (cons (reverse itm) rtn)
                              flg t
                        )
                    )
                    (   (equal (car itm) (cadr end) 1e-8)
                        (setq end (list (car end) (caddr itm))
                              rtn (append rtn (list itm))
                              flg t
                        )
                    )
                    (   (equal (caddr itm) (car end) 1e-8)
                        (setq end (cons (car itm) (cdr end))
                              rtn (cons itm rtn)
                              flg t
                        )
                    )
                    (   (equal (caddr itm) (cadr end) 1e-8)
                        (setq end (list (car end) (car itm))
                              rtn (append rtn (list (reverse itm)))
                              flg t
                        )
                    )
                    (   (setq tmp (cons itm tmp)))
                )
            )
            flg
        )
        (setq lst tmp tmp nil flg nil)
    )
    rtn
)


[Giuseppe Beatrice]

My thanks to all of you, and particularly to Lee Mac… excellent code!
I had developed a program to build a tree with connected  lwpolylines (too long and clumsy to attach it here).
Basically, the tree is constructed searching in a selection group the lines with an ending point coincident with the fixed origin point, and then searching for all the ramification lines (one or more) from the other end of each line, iterating the process to all selected polylines; when only one line is found, it is integrated in the branch like an extension of the branch itself.
Each branch is memorized in a variable, so -if I have two initial branches- their properties (ending points, length, etc.) are memorized in variables B1 and B2; successive ramifications (i.e. two from B1 and three from B2) they are memorized in variables B1_1, B1_2,  and  B2_1, B2_2, B2_3… and so on for all the lines in the selection group.
In this way I can calculate the length of each route from each free terminal point  to the origin, simply retrieving the sequence of variables from the last branch (B1_2_1…) to the first (B1). The names of the connected branches end-origin are just found iteratively truncating the string corresponding to the variable from “B1_2_1…” to “B1”.
The problem of my program is… the time of running, definitely excessive (in the order of minutes, or tens of minutes, for hundreds or thousands branches). Can you kindly suggest integrations to fit your program for “sorting” not only sequences of single lines?
Thank you very much, you're simply the best (and I beg your pardon for my poor english).

[Giuseppe Beatrice]

I attach a lisp that builds a list of endpoints and related entities.
It employs a time of about 20 sec to build the list with a DWG file with about 800 polylines linked together, but during this time Autocad 2014 interrupts the visibility of the progress bar to the value of 38% and appears an annoying circlet of waiting during which Autocad exposes the indication "not responding Autocad ". 
Can anyone help to normalize this behavior, perhaps with corrections to lisp to decrease the execution time? 

Code: [Select]

(defun SELEZIONE_LINEE    (/ l0 en0 p0 st sf s1 en0 lfin lnod lpt+ent et)
  (setq   l0  (entsel "Seleziona Ramo origine")
   en0 (car l0)
   p0  (cadr l0))
  (setq st (getvar 'millisecs)) ;_ inizio controllo primo ciclo
  (vl-load-com)
  (setq   sf (list '(-4 . "<OR")
       '(0 . "LINE,ARC")
       '(-4 . "<AND")
       '(0 . "LWPOLYLINE,SPLINE")
       '(-4 . "<NOT")
       '(-4 . "&=")
       '(70 . 1)
       '(-4 . "NOT>")
       '(-4 . "AND>")
       '(-4 . "<AND")
       '(0 . "POLYLINE")
       '(-4 . "<NOT")
       '(-4 . "&")
       '(70 . 89)
       '(-4 . "NOT>")
       '(-4 . "AND>")
       '(-4 . "<AND")
       '(0 . "ELLIPSE")
       '(-4 . "<OR")
       '(-4 . "<>")
       '(41 . 0.0)
       '(-4 . "<>")
       (cons 42 (+ pi pi))
       '(-4 . "OR>")
       '(-4 . "AND>")
       '(-4 . "OR>")
       (if (= 1 (getvar 'cvport)) ;_limitazione al solo layout corrente
         (cons 410 (getvar 'ctab))
         '(410 . "Model"))))
  (if (setq s1 (ssget "_X" sf)) ;_ tutte le entità che superano il filtro
    (setq lfin     (ALBERO_GREZZO s1 en0)
     lnod     (car lfin)
     lpt+ent (cdr lfin)))
  (setq et (getvar 'millisecs))
  (princ (strcat "\nTempo esecuzione programma: " (itoa (- et st)) " ms")))
               ;#################################################################################################################################################################################################

;;----------------------------------------------------------------------------------------------------------------------------------------------------------------
;|Funzione ricerca rami interconnessi |;
(defun ALBERO_GREZZO  (s1 en0 / en fl in l1 ln l2 s2 sf vl ltr ssvl)
  (ACET-UI-PROGRESS-INIT
    (strcat "Costruzione albero: " (itoa (sslength s1)) " polilinee totali da inserire...")
    (sslength s1)) ;_iniz. barra progresso con il totale numero rami
  (setq   s2  (ssadd en0) ;_creazione gruppo selezione s2 finale, inizialmente con sola entità origine (destinato a contenere anche tutte le entità che formano propaggini)
   l1  (list (vlax-curve-getstartpoint en0) (vlax-curve-getendpoint en0)) ;_lista estremi del primo ramo dell'albero (vettore)
   ln  (list (list (vlax-curve-getstartpoint en0)) (list (vlax-curve-getendpoint en0))) ;_lista nodi (i primi due estremi sono sicuramente dioversi tra loro
   ltr (list (append ln (list en0)))) ;_costruzione iniziale lista tratti ltr (vettore e nome ente)
  (repeat (setq in (sslength s1)) ;_formazione lista coppie di vertici di tutte le entità ricavate della selezione meno quella origine...
    (setq en (ssname s1 (setq in (1- in)))) ;_...estrazione entità
    (if   (not (eq en en0)) ;_ se l'entità non coincide con quella origine...
      (setq vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)))) ;_...di cui si ricavano i vettori (coppia dei vertici) nella lista vl (vector list)
  (while (progn   (foreach v  vl ;_ciascuna coppia di vertici v viene estratta...
        (if (vl-some '(lambda (p) (or (equal (car v) p 1e-8) (equal (cadr v) p 1e-8))) l1) ;_alla prima coincidenza di uno dei 2 vertici con un estremo p di l1...
          (setq s2  (ssadd (caddr v) s2) ;_...l'ente è aggiunto al gruppo s2
           l1  (vl-list* (car v) (cadr v) l1) ;_i punti estremi sono sono aggiunti a l1
           ln  (LISTA_NODI ln (cdr (reverse v)))
           ltr (append (list v) ltr) ;_ così come il corrispondente vettore è aggiunto a ltr
           fl  t)
          (setq l2 (cons v l2)))) ;_...altrimenti v è aggiunto alla lista l2 (rami non accoppiati)
      fl)
    (setq vl l2 ;_preparazione nuova vl (senza le entità accoppiate) per ripetizione ciclo confronto tra vl e nuova l1 (contenente anche  le entità accoppiate)
     l2 nil
     fl nil)
    (ACET-UI-PROGRESS-SAFE (length ltr)) ;_ misura avanzamento barra progresso
    )
  (if vl
    (ERROR_1 vl))
  (ACET-UI-PROGRESS-DONE) ;_chiusura barra di processo
  (cons ln ltr)) ;_fine defun con passaggio ltr alla funzione chiamante

;| Funzione ricerca nodi; confronta ciascuno dei punti estremi di un vettore con gli elementi della lista nodi.
   Se il punto coincide con un nodo già presente viene aggiunto ad esso nella sublista, altrimenti viene aggiunto alla lista nodi come nuova sublista
   |;

(defun LISTA_NODI  (ln le / sl1 sl2 sl2m lnm) ;(setq lns (mapcar 'car ln));_ lista nodi semplici (lista dei soli punti contenuti in ln)
  (setq lnm ln)
  (mapcar '(lambda (e / sl2)
        (setq sl2 (vl-member-if '(lambda (lp) (equal e (car lp) 1e-8)) lnm)) ;_se estremo è trovato fra i punti di lnm, restituita sl2 (sublista di lnm con estremo al primo posto)
        (if sl2 ;_ se esiste sublista sl2...
          (setq sl1  (LM:ListDifference lnm sl2) ;... si ricava anche la prima parte come differenza
           sl2m (subst (append (car sl2) (list e)) (car sl2) sl2) ;_... si modifica sl2 sostituendone il primo elemento con lo stesso modificato col punto aggiunto
           lnm  (LM:ListUnion sl1 sl2m)) ;_... quindi si ricostituisce la nuova lnm
          (setq lnm (append lnm (list (list e)))))) ;_... altrimenti lnm è modificata con l'aggiunta del punto non coincidente come nuova sublista
     le) ;_mapcar applicata al vettore per considerare i due estremi
  lnm) ;_fine defun

;; Funzione evidenziazione rami non integrabili nell'albero
(defun ERROR_1   (vl / ssvl)
  (setq ssvl (ssadd)) ;_creazione gruppo selezione vuoto
  (mapcar '(lambda (en) (ssadd en ssvl)) (mapcar 'caddr vl)) ;_aggiunta a ssvl di tutte le entità non integrate (al terzo posto della lista vl)
  (sssetfirst nil ssvl) ;_accensione grip su tutte le entità
  (exit)) ;_fine defun

(SELEZIONE_LINEE)
<CAB added code tags>

[CAB]

It might encourage users to help if you provided the test drawing.