Hybrid parallel

[marko_ribar]

From what I inspected... That @dexus code works well with correct implementation of djikstra... When I used his code it bumped into endless (while) loop... Here is my revision and it should work, but result is not exact... Seems that resulting polyline is rummaging between references...

Here is my revision :

; Attempt at drawing a centerline using voronoi diagram
; Voronoi diagram calculations found here: https://www.theswamp.org/index.php?topic=45085.msg503034#msg503034
(defun c:cl (/ _side ent->pts removeDuplicates minlen RemoveIDDup minpath1 triangulate getcircumcircle
               ss ent1 ent2 pl s1 s2 vor line)

  (defun _side (pline pnt / cpt end target der)
    (setq cpt (vlax-curve-getClosestPointTo pline pnt) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429
          end (vlax-curve-getEndParam pline)
          target (vlax-curve-getParamAtPoint pline cpt)
          der (if
                (and
                  (equal target (fix target) 1e-8)
                  (or
                    (vlax-curve-isClosed pline)
                    (and (not (equal (vlax-curve-getStartParam pline) target 1e-8)) (not (equal end target 1e-8)))
                  )
                )
                (mapcar (function -)
                  (polar cpt (angle (list 0.0 0.0) (vlax-curve-getFirstDeriv pline (rem (+ target 1e-3) end))) 1.0)
                  (polar cpt (angle (vlax-curve-getFirstDeriv pline (rem (+ (- target 1e-3) end) end)) (list 0.0 0.0)) 1.0)
                )
                (vlax-curve-getFirstDeriv pline target)
              )
    )
    (minusp (sin (- (angle cpt pnt) (angle (list 0.0 0.0) der))))
  )

  (defun _polyline (pts)
    (entmakex
      (append
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 (length pts))
          (cons 8 (getvar (quote clayer)))
          (cons 70 0)
        )
        (mapcar (function (lambda (x) (cons 10 x))) pts)
      )
    )
  )

  (defun ent->pts (ent acc / end ind step rtn)
    (setq end (vlax-curve-getEndParam ent))
    (setq ind (vlax-curve-getStartParam ent))
    (setq step (/ end (float acc)))
    (while (< ind end)
      (setq rtn (cons (vlax-curve-getPointAtParam ent ind) rtn))
      (setq ind (+ ind step))
    )
    rtn
  )

  (defun removeDuplicates (lst / a ll)
    (while (setq a (car lst))
      (if (vl-some (function (lambda (x) (equal x a 1e-6))) (cdr lst))
        (setq ll (cons a ll) lst (vl-remove-if (function (lambda (x) (equal x a 1e-6))) (cdr lst)))
        (setq ll (cons a ll) lst (cdr lst))
      )
    )
    (reverse ll)
  )

  ; https://www.theswamp.org/index.php?topic=45092.msg578984#msg578984
  (defun minlen (LtsLine startEnd / ID1 ID2 IDEnd IDStart LtsID LtsIDFil LtsIDPnt LtsID_Edge LtsPath P1 P2 listpoint)
    (setq LtsPnt (removeDuplicates (apply (function append) LtsLine)))
    (setq LtsIDPnt (mapcar (function (lambda (x) (list (vl-position x LtsPnt) x))) LtsPnt))
    (setq LtsID (mapcar (function (lambda (x) (vl-position x LtsPnt))) LtsPnt))
    (setq IDStart (vl-position (caar startEnd) LtsPnt))
    (setq IDEnd (vl-position (caadr startEnd) LtsPnt))
    (setq LtsID_Edge (list))
    (foreach e LtsLine
      (setq ID1 (caar (vl-remove-if-not (function (lambda (x) (equal (car e) (cadr x) 1e-6))) LtsIDPnt)))
      (setq ID2 (caar (vl-remove-if-not (function (lambda (x) (equal (cadr e) (cadr x) 1e-6))) LtsIDPnt)))
      (setq LtsID_Edge (append LtsID_Edge (list (list ID1 ID2 (distance (nth ID1 LtsPnt) (nth ID2 LtsPnt))))))
    )
    (setq LtsIDFil (RemoveIDDup LtsID_Edge))
    (setq LtsPath (minpath1 IDStart IDEnd LtsID LtsIDFil))
    (setq listpoint (mapcar (function (lambda (x) (nth (car x) LtsPnt))) LtsPath))
  )

  (defun RemoveIDDup (l)
    (if l
      (cons (car l)
        (RemoveIDDup
          (vl-remove-if
            (function (lambda (x)
              (or
                (and (= (car x) (car (car l)))
                     (= (cadr x) (cadr (car l)))
                )
                (and (= (car x) (cadr (car l)))
                     (= (cadr x) (car (car l)))
                )
              )
            ))
            (cdr l)
          )
        )
      )
    )
  )

  (defun minpath1 (g f nodes edges / brname clnodes closedl go new nodname old openl totdist ppath)
    (setq nodes (vl-remove g nodes))
    (setq openl (list (list g 0 nil)))
    (setq closedl nil)
    (setq go t)
    (foreach n nodes
      (setq nodes (subst (list n 0 nil) n nodes))
    )
    (while (and go (not (= (caar closedl) f)))
      (setq nodname (caar openl))
      (setq totdist (cadar openl))
      (setq closedl (cons (car openl) closedl))
      (setq openl (cdr openl))
      (setq clnodes (mapcar (function car) closedl))
      (foreach e edges
        (setq brname nil)
        (cond
          ( (= (car e) nodname)
            (setq brname (cadr e))
          )
          ( (= (cadr e) nodname)
            (setq brname (car e))
          )
        )
        (if brname
          (progn
            (setq new (list brname (+ (caddr e) totdist) nodname))
            (cond
              ( (member brname clnodes) )
              ( (setq old (vl-some (function (lambda (x) (if (= brname (car x)) x))) openl))
                (if (< (cadr new) (cadr old))
                  (setq openl (subst new old openl))
                )
              )
              ( t (setq openl (cons new openl)) )
            )
          )
        )
      )
      (setq openl (vl-sort openl (function (lambda (a b) (< (cadr a) (cadr b))))))
      (and (null openl) (null (caar closedl)) (setq go nil))
    )
    (setq ppath (list (car closedl)))
    (foreach n closedl
      (if (= (car n) (caddr (car ppath)))
        (setq ppath (cons n ppath))
      )
    )
    ppath
  )

  ;;***************************************************************************;
  ;; Triangulate                                                               ;
  ;; Structure of Program by  ElpanovEvgeniy                                   ;
  ;; 17.10.2008                                                                ;
  ;; edit 20.05.2011                                                           ;
  ;; Program triangulate an irregular set of 3d points.                        ;
  ;; Modified and Commented by ymg                             June 2011.      ;
  ;; Modified to operate on index by ymg in                    June 2013.      ;
  ;; Contour Generation added by ymg in                        July 2013.      ;
  ;; Removed lots of code not used for centerline function     November 2025.  ;
  ;;***************************************************************************;
  (defun triangulate (pl / a al b bb c cp ctr e el epos l n np npos pt r sl tl tr vl vor xmax xmin ymax ymin)
    (if pl
      (progn
        (setq tl nil
              pl (vl-sort pl (function (lambda (a b) (< (car a) (car b))))) ; Sort points list on x coordinates
              bb (list (apply 'mapcar (cons 'min pl)) (apply 'mapcar (cons 'max pl)))
              ; Replaced code to get the min and max with 3d Bounding Box Routine
              ; A bit slower but clearer. zmin and zmax kept for contouring
              xmin (caar bb)
              xmax (caadr bb)
              ymin (cadar bb)
              ymax (cadadr bb)
              np (length pl) ; Number of points to insert
              cp (list (/ (+ xmin xmax) 2.0) (/ (+ ymin ymax) 2.0)) ; Midpoint of points cloud and center point of circumcircle through supertriangle.
              r (* (distance cp (list xmin ymin)) 20) ; This could still be too small in certain case. No harm if we make it bigger.
              sl (list
                      (list (+ (car cp) r) (cadr cp) 0)
                      (list (- (car cp) r) (+ (cadr cp) r) 0)
                      (list (- (car cp) r) (- (cadr cp) r) 0)
              ) ; sl list of 3 points defining the Supertriangle, I have tried initializing to an infinite triangle but it slows down calculation
              pl (append pl sl) ; Vertex of Supertriangle are appended to the Point list
              sl (list np (+ np 1) (+ np 2)) ; sl now is a list of index into point list defining the supertriangle
              al (list (list xmax cp r sl))
              ; Initialize the Active Triangle list
              ; al is a list that contains active triangles defined by 4 items:
              ;                item 0: Xmax of points in triangle.
              ;                item 1: List 2d coordinates of center of circle circumscribing triangle.
              ;                item 2: Radius of above circle.
              ;                item 3: List of 3 indexes to vertices defining the triangle
              ctr (list cp) ; added for Voronoi
              n -1 ; n is a counting index into Point List
        )
        ; Begin insertion of points
        (repeat np
          (setq n (1+ n) ; Increment Index into Point List
                pt (nth n pl) ; Get one point from point list
                el nil) ; el list of triangles edges
          (repeat (length al) ; Loop to go through Active triangle list
            (setq tr (car al) ; Get one triangle from active triangle list.
                  al (cdr al)) ; Remove the triangle from the active list.
            (cond
              ( (< (car tr) (car pt))
                (setq tl (cons (cadddr tr) tl)
                      ctr (cons (cadr tr) ctr)) ; added for voronoi
              )
              ; This triangle inactive. We store it's 3 vertex in tl (Final triangle list).
              ( (< (distance pt (cadr tr)) (caddr tr)) ; pt is inside the triangle.
                (setq tr (cadddr tr) ; Trim tr to vertex of triangle only.
                      a (car tr) ; Index of First point.
                      b (cadr tr) ; Index of Second point.
                      c (caddr tr)) ; Index of Third point.
                      (setq el (vl-list* (list a b) (list b c) (list c a) el)) ; ((a b) (b c) (c a) (. .) (. .).....)
              )
              ( t (setq l (cons tr l)) ) ; tr did not meet any cond so it remain active. We store it in the swap list
            ) ; End cond
          ) ; End repeat (length al)
          (setq al l ; Restore active triangle list from the temporary list.
                l nil) ; Clear the swap list to prepare for next insertion.
          ; Removes doubled edges, calculates circumcircles and add them to al
          (while el
            (if
              (or
                (member (reverse (car el)) el)
                (member (car el) (cdr el))
              )
              (setq el (vl-remove (reverse (car el)) el)
                    el (vl-remove (car el) el))
              (setq al (cons (getcircumcircle n (car el) pl) al)
                    el (cdr el))
            )
          )
        ) ; End repeat np
        ; We are done with points insertion. Any triangle left in al is added to tl
        (foreach tr al
          (setq tl (cons (cadddr tr) tl)
                ctr (cons (cadr tr) ctr)) ; Added for Voronoi
        )
        ; Extract all triangle edges from tl and form edges list el
        (setq el nil)
        (foreach tr tl
          (setq el
            (vl-list*
              (list (caddr tr) (car tr))
              (list (cadr tr) (caddr tr))
              (list (car tr) (cadr tr))
              el
            )
          )
        )
        (setq el (reverse el))
        ; Here let's draw the Voronoi Diagram
        (setq vl nil)
        (foreach e el
          (setq npos (vl-position (reverse e) el)
                epos (vl-position e el))
          (if npos
            (setq vl (cons (list (/ npos 3) (/ epos 3)) vl))
            (setq vl (cons (list (- (length ctr) 1) (/ epos 3)) vl))
          )
        )
        (setq vor nil)
        (while vl
          (setq e (car vl)
                vl (vl-remove (reverse e) (cdr vl))
                vor (cons e vor))
        )
        (mapcar
          (function (lambda (v)
            (list
              (nth (cadr v) ctr)
              (nth (car v) ctr)
            )
          ))
          (cdddr ; Remove the edges of Supercircle
            (vl-sort vor
              (function (lambda (a b)
                (> (car a) (car b))
              ))
            )
          )
        )
      )
    )
  )

  ;;************************************************************************************************;
  ;; Written by  ElpanovEvgeniy                                                                     ;
  ;; 17.10.2008                                                                                     ;
  ;; Calculation of the centre of a circle and circle radius                                        ;
  ;; for program triangulate                                                                        ;
  ;;                                                                                                ;
  ;; Modified ymg june 2011 (renamed variables)                                                     ;
  ;; Modified ymg June 2013 to operate on Index                                                     ;
  ;;************************************************************************************************;
  (defun getcircumcircle (a el pl / b c c2 cp r ang vl pt)
    (setq pt (nth a pl)
          b (nth(car el) pl)
          c (nth(cadr el) pl)
          c2 (list (car c) (cadr c)) ; c2 is point c but in 2d
          vl (list a (car el) (cadr el)))
    (if (not (zerop (setq ang (- (angle b c) (angle b pt)))))
      (progn
        (setq cp (polar c2 (+ -1.570796326794896 (angle c pt) ang) (setq r (/ (distance pt c2) (sin ang) 2.0)))
              r (abs r))
        (list (+ (car cp) r) cp r vl)
      )
    )
  )

  (if
    (not 
      (while
        (cond
          ( (not (setq ss (ssget (list (cons 0 "LWPOLYLINE")))))
            (princ "\nNothing selected. Try again...\n")
          )
          ( (/= (sslength ss) 2)
            (princ "\nSelect 2 polylines! Try again...\n")
          )
          ( (and
              (setq ent1 (ssname ss 0))
              (setq ent2 (ssname ss 1))
              (setq pl (append (ent->pts ent1 100) (ent->pts ent2 100)))
              (setq ent1 (vlax-ename->vla-object ent1))
              (setq ent2 (vlax-ename->vla-object ent2))
            )
            nil ; Stop loop
          )
        )
      )
    )
    (progn
      (setq s1 (_side ent1 (vlax-curve-getStartPoint ent2)))
      (setq s2 (_side ent2 (vlax-curve-getStartPoint ent1)))
      (setq vor (triangulate pl))
      (setq vor
        (vl-remove-if-not
          (function (lambda (line)
            (and
              (equal s1 (_side ent1 (car line)))
              (equal s1 (_side ent1 (cadr line)))
              (equal s2 (_side ent2 (car line)))
              (equal s2 (_side ent2 (cadr line)))
            )
          ))
          (vl-remove-if (function (lambda (x) (or (equal x (list nil nil)) (not (car x)) (not (cadr x))))) vor)
        )
      )
      (if
        (<
          (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent2))
          (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2))
        )
        (setq start (list (vlax-curve-getEndPoint ent1) (vlax-curve-getStartPoint ent1))
              end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2)))
        (setq start (list (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1))
              end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2)))
      )
      (setq startEnd
        (mapcar
          (function (lambda (end1 end2)
            (caar
              (vl-sort
                (mapcar
                  (function (lambda (line)
                    (list
                      line
                      (+
                        (distance (car line) end1)
                        (distance (car line) end2)
                        (distance (cadr line) end1)
                        (distance (cadr line) end2)
                      )
                    )
                  ))
                  vor
                )
                (function (lambda (a b)
                  (< (cadr a) (cadr b))
                ))
              )
            )
          ))
          start end
        )
      )
      (_polyline
        (
          (lambda (lst / rtn) ; Draw a line of the midpoints of voronoi lines
            (while (cdr lst)
              (setq rtn
                (cons
                  (mapcar
                    (function (lambda (a b) (* (+ a b) 0.5)))
                    (car lst)
                    (cadr lst)
                  )
                  rtn
                )
              )
              (setq lst (cdr lst))
            )
            rtn
          )
          (minlen vor startEnd)
        )
      )
    )
  )
  (princ)
)