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 5 hours ago 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 6 hours ago 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 3 hours ago 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 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 t (fix (vlax-curve-getEndParam ent1))
      (while (<= i t)
        (setq ptv (vlax-curve-getPointAtParam ent1 i))
        (setq ptc (vlax-curve-getClosestPointTo ent2 ptv))
        (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 t (fix (vlax-curve-getEndParam ent2))
      (while (<= i t)
        (setq ptv (vlax-curve-getPointAtParam ent2 i))
        (setq ptc (vlax-curve-getClosestPointTo ent1 ptv))
        (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)
)

 

Edited 27 minutes ago by mhupp