Hybrid parallel

[PGia]

I was wrong.

c:CPL of @GP_ is also inconsistent in some cases.

CPL.dwg

[PGia]

14 minutes ago, PGia said:

I was wrong.

c:CPL of @GP_ is also inconsistent in some cases.

CPL.dwg 48.18 kB · 0 downloads

 

Welcome back to big game hunting!

[SLW210]

1 hour ago, PGia said:

I was wrong.

c:CPL of @GP_ is also inconsistent in some cases.

CPL.dwg 48.18 kB · 1 download

 

I already stated that in a few posts. All of them fail in certain situations.

 

That's why people are still taking a shot at solving the issue.

 

I have also already mentioned Civil/GIS programs can do this pretty well. QGIS (free/donation) has a plug-in to do this.

[dexus]

Here is my first attempt at this problem.

It creates offset lines and checks the intersections. The precision is dictated by the offsetdistance.

The lower it is, the longer it takes to make the polyline and the more points it will have. But it will be more accurate.

 

Afterwards I run this function on the resulting polyline to clean it up. 

 

;|
; Center line - dexus
; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel
|;
(defun c:testcl (/ ent1 lst offset offsetdistance pts r s1 s2 ss start te1 te2)

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

  (defun _side (pline pnt / cpt end target der) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429
    (setq cpt (vlax-curve-getClosestPointTo pline pnt)
          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 '-
                  (polar cpt (angle '(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)) '(0 0)) 1.0)
                )
                (vlax-curve-getFirstDeriv pline target)
              )
            )
    (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der))))
  )

  ;; Intersections - Lee Mac
  ;; mod - [int] acextendoption enum of intersectwith method
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if
      (and
        (vlax-method-applicable-p ob1 'intersectwith)
        (vlax-method-applicable-p ob2 'intersectwith)
        (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
      (repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst))
      )
    )
    (reverse rtn)
  )

  (defun getLength (ent)
    (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
  )

  (if
    (not 
      (while
        (cond
          ((not (setq ss (ssget '((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 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 maxlen (max (getLength ent1) (getLength ent2)))
      (setq offset 0.0)
      (setq offsetdistance (/ maxlen 1024.0))
      (while
        (progn
          (setq offset (+ offset offsetdistance))
          (setq te1 nil)
          (setq te2 nil)
          (setq r
            (cond
              ( (or ; Make offset
                  (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if s1 offset (- offset))))))
                  (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if s2 offset (- offset))))))
                )
                (princ "\nOffset failed. ")
                nil
              )
              ((setq lst (LM:intersections (car te1) (car te2) acExtendNone))
                (setq len (getLength (car te1)))
                (setq lst (mapcar (function (lambda (pt) (list (/ (vlax-curve-getDistAtPoint (car te1) pt) len) pt))) lst))
                (setq start t)
                (setq pts (append lst pts))
              )
              ((> offset maxlen) nil)
              ((not start) t)
              (start nil)
            )
          )
          (if te1 (mapcar 'vla-delete te1))
          (if te2 (mapcar 'vla-delete te2))
          r
        )
      )
      (if pts
        (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))))
      )
    )
  )
)

 

 

Edited yesterday at 02:12 PM by dexus

[GP_]

2 hours ago, PGia said:

I was wrong.

c:CPL of @GP_ is also inconsistent in some cases.

 

 

Could you post the dwg?

 

Edited yesterday at 12:43 PM by GP_

[PGia]

21 minutes ago, GP_ said:

 

Could you post the dwg?

 

 

I already attached it in one of my two previous posts

[GP_]

2 hours ago, PGia said:

 

I already attached it in one of my two previous posts

 

In the DWG files you posted, I can't find the polylines indicated in the images.
I don't think that result was obtained with CPL.
I'd like to run a test, so please attach the DWG file with the reference position in the images.
Thanks

[mhupp]

45 minutes ago, GP_ said:

 

In the DWG files you posted, I can't find the polylines indicated in the images

 

https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/2/#findComment-676816

 

The last code i posted works well on two open polylines. its just when they loop back on themselves that only checking the distance gets points get out of order. haven't had time to code but I think I have a solution creating a dotted pair list.

Edited yesterday at 03:57 PM by mhupp

[PGia]

30 minutes ago, GP_ said:

 

In the DWG files you posted, I can't find the polylines indicated in the images.
I don't think that result was obtained with CPL.
I'd like to run a test, so please attach the DWG file with the reference position in the images.
Thanks

 

The overall view of the drawing looks like this

[PGia]

I've attached it again below

 

 

CPL.dwg

[mhupp]

See if this works will tweek it tonight if something throws error.

 

Modified version of my last code

• Ask user to select first and 2nd polyline
• Find mid points from each vertex of poly1 to poly 2 with vlax-curve-getClosestPointTo
• Adds those points to a dotted pair with the vertex number
• Creates a temp polyine with those points
• Find minpoints from each vertex of poly2 to poly one with vlax-curve-getClosestPointTo
• Processed the 2nd list of points using vlax-curve-getClosestPointTo to temp polyline
• Using that with vlax-curve-getParamatpoint will tell where on the tempoly if falls
• Sort polylist by the parma so they will be in order and removing the parama so only point data is left
• Delete temp polyline 
• Create new mid polyline with all points in right order.

 

Stuff that is doing the heavy lifting is vlax-curve-getClosestPoint and vlax-curve-getParamatpoint. this will work with polylines with arc's but will only generate a mid polyline using straight lines.  Everything you post they don't seem to have any arcs so you should be good.

 

;;----------------------------------------------------------------------------;;
;; POLY AVERAGE path between polylines, Finds the mid path
(defun c:PA () (C:POLYAVG))
(defun c:POLYAVG (/ ent1 ent2 i tol ptv ptc par mid pts1 pts2 polylst tempoly)
  (setq ent1 (car (entsel "\nSelect first polyline: ")))
  (if (not (and ent1 (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE")))
    (progn
      (princ "\nInvalid 1st selection.") (exit)
    )
    (setq ent1 (vlax-ename->vla-object ent1))
  )
  (setq ent2 (car (entsel "\nSelect 2nd polyline: ")))
  (if (not (and ent2 (= (cdr (assoc 0 (entget ent2))) "LWPOLYLINE")))
    (progn
      (princ "\nInvalid first selection.") (exit)
    )
    (setq ent2 (vlax-ename->vla-object ent2))
  )
  (if (and ent1 ent2)
    (progn
      (setq pts1 '())
      (setq i 0)
      (setq tol (fix (vlax-curve-getEndParam ent1)))
      (while (<= i tol)
        (setq ptv (vlax-curve-getPointAtParam ent1 i))
        (setq ptc (vlax-curve-getClosestPointTo ent2 ptv))
        ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc)))
        (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2)))
        (setq pts1 (append pts1 (list mid)))
        (setq polylst (cons (cons mid i) polylst))
        (setq i (1+ i))
      )
      (setq Flag (if (= (vla-get-Closed ent1) :vlax-true) 1 0))  ; Get closed status
      (entmake
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length pts1))
            (cons 70 flag)
          )
          (mapcar '(lambda (p) (cons 10 p)) pts1)
        )
      )
      (setq tempoly (entlast))
      (setq pts2 '())
      (setq i 0)
      (setq tol (fix (vlax-curve-getEndParam ent2)))
      (while (<= i tol)
        (setq ptv (vlax-curve-getPointAtParam ent2 i))
        (setq ptc (vlax-curve-getClosestPointTo ent1 ptv))
        ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc)))
        (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2)))
        (setq pts2 (append pts2 (list mid)))
        (setq i (1+ i))
      )
      (foreach pt pts2
        (setq ptv (vlax-curve-getClosestPointTo tempoly pt))
        (setq Par (vlax-curve-getParamatpoint tempoly ptv))
        (setq polylst (cons (cons pt par) polylst))
      )
      (setq polylst (mapcar 'car (vl-sort polylst '(lambda (a b) (< (cdr a) (cdr b))))))
      (entdel tempoly)
      (entmake
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length polylst))
            (cons 70 flag)
          )
          (mapcar '(lambda (p) (cons 10 p)) polylst)
        )
      )
      (princ "\nNew midpoint polyline created.")
    )
    (princ "\nSelection error.")
  )
  (princ)
)

 

-Edit

 

Still a little janky but you can see why if you un-comment the entmake lines

 

Edited 18 hours ago by mhupp

[Steven P]

Thinking I understood that one....

In my attempt (sorry folks haven't had a chance to look at it this week yet) I was half way here, created a temp poly line mid point between poly 1 end points and closest on poly 2. Created a list of points mid point from poly 2 to closest point on poly 1 (the reverse) then ent mod the temp poly adding in new points as required... it didn't work 100%. Tried to think how to combine the 2 lists of points (1 to 2, 2 to 1). Point at Param might be the one to go for.

 

Spanner in the works... what happens if the end points are not aligned, example closed polylines, first point on poly 1 say at the 12:00 position, first point on poly 2 say at 3:00 position? - think it will work OK

[mhupp]

2 hours ago, Steven P said:

Spanner in the works... what happens if the end points are not aligned, example closed polylines, first point on poly 1 say at the 12:00 position, first point on poly 2 say at 3:00 position? - think it will work OK

 

With my code it wouldn't matter because they would reorder on how they fall on the temp polyline unless one poly line is really squiggly (technical term)

Edited 18 hours ago by mhupp

[dexus]

I made some changes so it also works when the starting lines are intersecting.

Cool to see lots of people try to solve this problem!

 

Mine doesn't work well with parallel lines and doesn't generate arcs.

It still looks like GP_'s solution has the best result for me, but for intersecting lines I have to execute the function twice and select the lines in two directions to get the full result.

 

 

centerline.lsp

 

Edited 2 hours ago by dexus
Fixed some errors

[PGia]

@dexus 

I tested your first code.

It's quite close to what the centerline should be, although at the inflection points it always works by approximation. It seems the goal is to obtain many points along the line to always be close to the correct axis, but: why not obtain the correct axis from the first point?

In my opinion, it should be possible to obtain only the inflection points that will become segments equidistant from the reference polylines. Furthermore, in the middle of these inflection points there shouldn't be any more unnecessary points, but rather a single segment.

 

As for your last code, I couldn't get it to run because some kind of error occurs.

Edited 4 hours ago by PGia

[PGia]

21 hours ago, mhupp said:

See if this works will tweek it tonight if something throws error.

 

Modified version of my last code

• Ask user to select first and 2nd polyline
• Find mid points from each vertex of poly1 to poly 2 with vlax-curve-getClosestPointTo
• Adds those points to a dotted pair with the vertex number
• Creates a temp polyine with those points
• Find minpoints from each vertex of poly2 to poly one with vlax-curve-getClosestPointTo
• Processed the 2nd list of points using vlax-curve-getClosestPointTo to temp polyline
• Using that with vlax-curve-getParamatpoint will tell where on the tempoly if falls
• Sort polylist by the parma so they will be in order and removing the parama so only point data is left
• Delete temp polyline 
• Create new mid polyline with all points in right order.

 

Stuff that is doing the heavy lifting is vlax-curve-getClosestPoint and vlax-curve-getParamatpoint. this will work with polylines with arc's but will only generate a mid polyline using straight lines.  Everything you post they don't seem to have any arcs so you should be good.

 

;;----------------------------------------------------------------------------;;
;; POLY AVERAGE path between polylines, Finds the mid path
(defun c:PA () (C:POLYAVG))
(defun c:POLYAVG (/ ent1 ent2 i tol ptv ptc par mid pts1 pts2 polylst tempoly)
  (setq ent1 (car (entsel "\nSelect first polyline: ")))
  (if (not (and ent1 (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE")))
    (progn
      (princ "\nInvalid 1st selection.") (exit)
    )
    (setq ent1 (vlax-ename->vla-object ent1))
  )
  (setq ent2 (car (entsel "\nSelect 2nd polyline: ")))
  (if (not (and ent2 (= (cdr (assoc 0 (entget ent2))) "LWPOLYLINE")))
    (progn
      (princ "\nInvalid first selection.") (exit)
    )
    (setq ent2 (vlax-ename->vla-object ent2))
  )
  (if (and ent1 ent2)
    (progn
      (setq pts1 '())
      (setq i 0)
      (setq tol (fix (vlax-curve-getEndParam ent1)))
      (while (<= i tol)
        (setq ptv (vlax-curve-getPointAtParam ent1 i))
        (setq ptc (vlax-curve-getClosestPointTo ent2 ptv))
        ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc)))
        (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2)))
        (setq pts1 (append pts1 (list mid)))
        (setq polylst (cons (cons mid i) polylst))
        (setq i (1+ i))
      )
      (setq Flag (if (= (vla-get-Closed ent1) :vlax-true) 1 0))  ; Get closed status
      (entmake
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length pts1))
            (cons 70 flag)
          )
          (mapcar '(lambda (p) (cons 10 p)) pts1)
        )
      )
      (setq tempoly (entlast))
      (setq pts2 '())
      (setq i 0)
      (setq tol (fix (vlax-curve-getEndParam ent2)))
      (while (<= i tol)
        (setq ptv (vlax-curve-getPointAtParam ent2 i))
        (setq ptc (vlax-curve-getClosestPointTo ent1 ptv))
        ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc)))
        (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2)))
        (setq pts2 (append pts2 (list mid)))
        (setq i (1+ i))
      )
      (foreach pt pts2
        (setq ptv (vlax-curve-getClosestPointTo tempoly pt))
        (setq Par (vlax-curve-getParamatpoint tempoly ptv))
        (setq polylst (cons (cons pt par) polylst))
      )
      (setq polylst (mapcar 'car (vl-sort polylst '(lambda (a b) (< (cdr a) (cdr b))))))
      (entdel tempoly)
      (entmake
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length polylst))
            (cons 70 flag)
          )
          (mapcar '(lambda (p) (cons 10 p)) polylst)
        )
      )
      (princ "\nNew midpoint polyline created.")
    )
    (princ "\nSelection error.")
  )
  (princ)
)

 

-Edit

 

Still a little janky but you can see why if you un-comment the entmake lines

 

 

I’ve also tested @mhupp’s code.
It gets fairly close to the centerline, but some strange errors appear.

I think relying solely on finding the correct axis vertices probably means you can’t immediately compensate for an inaccurate result.

That’s the downside of both Mhupp’s and GLAVCVS’s codes (his “one-eyed” version also produces odd results at times). SLW210’s approach might offer both options, but its outcome isn’t any better either.

 

I suppose a method based on calculating many points helps to average out those errors, but the result can only be an approximation.

 

And IMO, the result shouldn’t be an approximation — it should be exact.

[dexus]

I fixed some of the errors, could you try again @PGia ?

I see your point, it would be good to add the exact points on the corners to the estimated points from the rest of the function. Combine them into one polyline for a better result. I'll give it a try later when I have some time.

Edited 1 hour ago by dexus