Hybrid parallel

[SLW210]

Yes, GP_'s need Express Tools AFAIK.

 

As I posted, It still is off from yours on some corners.

 

It also creates lines and splines, though easy enough to make them polylines.

[PGia]

2 hours ago, SLW210 said:

Yes, GP_'s need Express Tools AFAIK.

 

As I posted, It still is off from yours on some corners.

 

It also creates lines and splines, though easy enough to make them polylines.

 

Yes
I already said my method wasn't perfect.

That's why, besides Lisp, I wanted to know if there was a better method than mine.
And the result GP_'s Lisp achieves corresponds very well with what I understand to be a correct axis.

The only drawback might be using this code in AutoCAD 2000.

But I suppose I can avoid that in AutoCAD 2015.

[GP_]

On 10/27/2025 at 12:31 PM, SLW210 said:

Command: CPL

Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.

 

 

3 hours ago, SLW210 said:

It also creates lines and splines, though easy enough to make them polylines.

 

Normally the final result is a polyline, maybe you don't have ExpressTools loaded, try:

(or acet-flatn (load "FLATTENSUP.LSP"))

[SLW210]

1 hour ago, GP_ said:

 

 

Normally the final result is a polyline, maybe you don't have ExpressTools loaded, try:

(or acet-flatn (load "FLATTENSUP.LSP"))

 

Yes, I added 

(acet-load-expresstools)

 

Answered by me.

 

Gian's (as well as the other LISPs) still want to cut some corners short, etc. IMHO. 

 

@mhupp's actually does some of the corners better, though "off" in other places.

 

I believe Civil 3D has something to do this, but it may not be much better.

 

If I get more time I'm still going to work on improving mine.

 

 

[GP_]

 

14 minutes ago, SLW210 said:

 

Yes, I added 

(acet-load-expresstools)

 

Answered by me.

 

It's true... sorry 

 

 

14 minutes ago, SLW210 said:

I believe Civil 3D has something to do this, but it may not be much better.

 

I'm curious to see if there are any differences.

[SLW210]

 

If I get any time at home, I'll do some testing in AutoCAD 2000i.

[GLAVCVS]

 

Calculating an axis using angle bisectors

a) Attempt number 1 (it was my first impulse, but I came up with a better one later)
Advantages:
- Pure LISP: doesn't depend on Express Tools,
- It's faster

Disadvantages:
- The result isn't as good as @GP_'s  "c:CPL"

- It only accepts LWPOLYLINES and ignores arcs

 

Basically, the approach is to obtain angle bisectors on each polyline, extend them to the other reference polyline, and use their midpoints.

The result is acceptably good, but not as accurate as c:CPL.

 

 

(defun c:creAxis (/ e e1 e2 l1 l2 lr p p0 p1 p2 px pm abis lii pmi pfi pi1 pi2 pf1 pf2 dameInters+Prox ordena)
  (defun dameInters+Prox (p0 a lp / p1 px pt1 pt2 dmin d pf)
    (setq pt1 (polar p0 a 1e8) pt2 (polar p0 (+ a PI) 1e8))
    (foreach p lp
      (if p1
        (if (setq px (inters pt1 pt2 p1 p))
	  (if dmin (if (< (setq d (distance px p0)) dmin) (setq dmin d pf px)) (setq dmin (distance px p0) pf px))
        )
      )
      (setq p1 p)
    )
    pf
  )

  (defun ordena (pr lp / d dmin ps lr)
    (while lp
      (foreach p lp
	(if dmin
	  (if (< (setq d (distance p pr)) dmin)
	    (setq dmin d ps p)
	  )
	  (setq	dmin (distance p pr) ps p)
	)
      )
      (setq dmin nil pr ps lp (vl-remove ps lp) lr (append lr (list ps)))
    )	
  )
  (if (and (setq e1 (car (entsel "\nSelect first LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") (not (redraw e1 3)))
    (if (and (setq e2 (car (entsel "\nSelect second LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") (not (redraw e2 3)))
      (progn
	(setq lp1 (reverse (foreach l l1 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil;
	      lp2 (reverse (foreach l l2 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil;
	)
	(if (< (distance (setq pi1 (cdr (assoc 10 l1))) (setq pi2 (cdr (assoc 10 l2)))) (distance pi1 (setq pf2 (cdr (assoc 10 (reverse l2))))))
	  (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pi1 pi2)
		pfi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (setq pf1 (cdr (assoc 10 (reverse l1)))) pf2)
	  )
	  (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pi1 pf2)
		pfi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (cdr (assoc 10 (reverse l1))) pi2)
	  )
	)
	(redraw e1 4)
	(redraw e2 4)
	(foreach l l1
	  (if (= (car l) 10)
	    (if p1
	      (if p2
		(setq abis (+ (/ (+ (angle p1 p2) (angle p2 (cdr l))) 2) (/ PI 2.)) x (princ)
		      px (dameInters+Prox p2 abis lp2)
		      lr nil
		      pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px))
		      lii (if px (append lii (list pm)) lii)
		      p1 p2 p2 (cdr l)
		)
		(setq p2 (cdr l))
	      )
	      (setq p1 (cdr l))
	    )
	  )
	)
	(setq p1 nil p2 nil lr nil)
	(foreach l l2
	  (if (= (car l) 10)
	    (if p1
	      (if p2
		(setq abis (+ (/ (+ (angle p1 p2) (angle p2 (cdr l))) 2.) (/ PI 2.))
		      px (dameInters+Prox p2 abis lp1);
		      pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px) (princ) )
		      lii (if px (append lii (list pm)) lii);
		      p1 p2 p2 (cdr l)
		)
		(setq p2 (cdr l))
	      )
	      (setq p1 (cdr l))
	    )
	  )
	)
	(setq lii (append (list pmi) (ordena pmi lii) (list pfi)))
      )
    )
  )
  (entmake (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (70 . 0) (60 . 0)) (list (cons 90 (length lii))) (mapcar '(lambda (a) (cons 10 a)) lii)))
  (princ)
)

 

 

PS: It seems to work well, but I haven't tested it extensively.

As I said at the beginning, there's a better approach, using angle bisectors, which I'll publish later.

 

Edited Wednesday at 11:43 AM by GLAVCVS

[mhupp]

Thought we were getting tolled when i saw @GP_ GIF had to double take on the original posted dwg.

 

Edited Thursday at 12:10 AM by mhupp

[SLW210]

23 hours ago, GLAVCVS said:

 

Calculating an axis using angle bisectors

a) Attempt number 1 (it was my first impulse, but I came up with a better one later)
Advantages:
- Pure LISP: doesn't depend on Express Tools,
- It's faster

Disadvantages:
- The result isn't as good as @GP_'s  "c:CPL"

- It only accepts LWPOLYLINES and ignores arcs

 

Basically, the approach is to obtain angle bisectors on each polyline, extend them to the other reference polyline, and use their midpoints.

The result is acceptably good, but not as accurate as c:CPL.

 

 

 

PS: It seems to work well, but I haven't tested it extensively.

As I said at the beginning, there's a better approach, using angle bisectors, which I'll publish later.

 

 

Does very well on some examples, but fails on a couple.

 

From OPs original drawing (this one has given me problems as well) and a few shapes I made it didn't close the centerline.

 

[Steven P]

Dinner time but been playing with this for interest. Will leave this here to pick up next time....

 

This looks at both polylines and draws a point at the mid point between every point and the closest point on the other for each.

 

Not quite there with it yet though, but might give an idea for later. The point list used for drawing the points isn't in order so drawing a line sometimes gives odd results - need to have a think how to set the order of these to draw the lines.

 

Left this drawing the shortest distances between polyline points and lines just for my checking.

One last thing for next time is to fix any arc segments.. but getting there.

 

(defun c:PolyMD ( / acount MyPoly1 MypolyEnt1 MyPolyVert1 MyPoly2 MypolyEnt2 MyPolyVert2 pt pt1 pt2 Ptist1 PtList2 LinePt)
    (defun mAssoc ( key lst / result )
     (foreach x lst
       (if (= key (car x))
         (setq result (cons (cdr x) result))
       )
     )
     (reverse result)
   ) ; end Massoc
   (defun midpt (p1 p2)
     (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) )
    )
   (defun LM:Unique ( l )
     (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
   )

   (defun CtrCoo ( a / findctr a apt)
   ;;https://www.cadtutor.net/forum/topic/66091-centre-of-hatch/
     (defun findctr (en / pt)
       (command "_.Zoom" "_Object" en "")
       (setq pt (getvar 'viewctr))
       (command "_.Zoom" "_Previous")
       pt
       )
       (setq ;;a (car (entsel "Select Rectangle: : "))
             apt (findctr a)
       )
   )


  (defun MakePoint ( pt / )
    (entmakex (list
      '(0 . "POINT")
      '(100 . "AcDbEntity")
      '(100 . "AcDbPoint")
      (cons 10 pt)
    ))
  )
  (defun MakeLine (pt1 pt2 / )
    (entmakex (list
      '(0 . "LINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbLine")
      (cons 10 pt1)
      (cons 11 pt2)
    ))
  )



 ;; Create extract arcs from polyline defun for curves


   (setq MyPoly1 (car (entsel "\nSelect Polyline 1: ")))
   (setq MyPoly1Ent (entget MyPoly1))
   (setq MyPoly1Vert (mAssoc 10 MyPoly1Ent))
   (setq Poly1CtrCoo (CtrCoo MyPoly1))
   (setq MyPoly2 (car (entsel "\nSelect Polyline 2: ")))
   (setq MyPoly2Ent (entget MyPoly2))
   (setq MyPoly2Vert (mAssoc 10 MyPoly2Ent))

   (foreach pt MyPoly1Vert
     (setq pt2 (vlax-curve-getclosestpointto MyPoly2 pt _none))
   (makeline pt pt2)
     (setq PtList1 (cons (midpt pt pt2) PtList1))
   ) ; end foreach
   (foreach pt MyPoly2Vert
     (setq pt1 (vlax-curve-getclosestpointto MyPoly1 pt _none))
   (makeline pt pt1)
     (setq PtList1 (cons (midpt pt pt1) PtList1)) ;;not sure which to go with
     (setq PtList2 (cons (midpt pt pt1) PtList2))
   ) ; end foreach
   (setq PtList1 (lm:unique (reverse PtList1)))


   (foreach pt PtList1
     (Makepoint pt)
   )

;;Work out if midpoints outside of exterior polyline (in case of complicated shapes)
;;Work out order of points to link together
;;Work out polyline bulges

 )

 

Edited Thursday at 11:39 PM by Steven P

[PGia]

16 hours ago, Steven P said:

Dinner time but been playing with this for interest. Will leave this here to pick up next time....

 

This looks at both polylines and draws a point at the mid point between every point and the closest point on the other for each.

 

Not quite there with it yet though, but might give an idea for later. The point list used for drawing the points isn't in order so drawing a line sometimes gives odd results - need to have a think how to set the order of these to draw the lines.

 

Left this drawing the shortest distances between polyline points and lines just for my checking.

One last thing for next time is to fix any arc segments.. but getting there.

 

(defun c:PolyMD ( / acount MyPoly1 MypolyEnt1 MyPolyVert1 MyPoly2 MypolyEnt2 MyPolyVert2 pt pt1 pt2 Ptist1 PtList2 LinePt)
    (defun mAssoc ( key lst / result )
     (foreach x lst
       (if (= key (car x))
         (setq result (cons (cdr x) result))
       )
     )
     (reverse result)
   ) ; end Massoc
   (defun midpt (p1 p2)
     (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) )
    )
   (defun LM:Unique ( l )
     (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
   )

   (defun CtrCoo ( a / findctr a apt)
   ;;https://www.cadtutor.net/forum/topic/66091-centre-of-hatch/
     (defun findctr (en / pt)
       (command "_.Zoom" "_Object" en "")
       (setq pt (getvar 'viewctr))
       (command "_.Zoom" "_Previous")
       pt
       )
       (setq ;;a (car (entsel "Select Rectangle: : "))
             apt (findctr a)
       )
   )


  (defun MakePoint ( pt / )
    (entmakex (list
      '(0 . "POINT")
      '(100 . "AcDbEntity")
      '(100 . "AcDbPoint")
      (cons 10 pt)
    ))
  )
  (defun MakeLine (pt1 pt2 / )
    (entmakex (list
      '(0 . "LINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbLine")
      (cons 10 pt1)
      (cons 11 pt2)
    ))
  )



 ;; Create extract arcs from polyline defun for curves


   (setq MyPoly1 (car (entsel "\nSelect Polyline 1: ")))
   (setq MyPoly1Ent (entget MyPoly1))
   (setq MyPoly1Vert (mAssoc 10 MyPoly1Ent))
   (setq Poly1CtrCoo (CtrCoo MyPoly1))
   (setq MyPoly2 (car (entsel "\nSelect Polyline 2: ")))
   (setq MyPoly2Ent (entget MyPoly2))
   (setq MyPoly2Vert (mAssoc 10 MyPoly2Ent))

   (foreach pt MyPoly1Vert
     (setq pt2 (vlax-curve-getclosestpointto MyPoly2 pt _none))
   (makeline pt pt2)
     (setq PtList1 (cons (midpt pt pt2) PtList1))
   ) ; end foreach
   (foreach pt MyPoly2Vert
     (setq pt1 (vlax-curve-getclosestpointto MyPoly1 pt _none))
   (makeline pt pt1)
     (setq PtList1 (cons (midpt pt pt1) PtList1)) ;;not sure which to go with
     (setq PtList2 (cons (midpt pt pt1) PtList2))
   ) ; end foreach
   (setq PtList1 (lm:unique (reverse PtList1)))


   (foreach pt PtList1
     (Makepoint pt)
   )

;;Work out if midpoints outside of exterior polyline (in case of complicated shapes)
;;Work out order of points to link together
;;Work out polyline bulges

 )

 

Thank you @Steven P

The problem with creating the centerline using perpendiculars is that even in straight sections, the centerline is not equidistant perpendicularly from the reference polylines (unless the reference polylines are parallel). 

This is the method I used manually, but I didn't achieve this goal.

 

Edited yesterday at 10:27 AM by PGia

[PGia]

And, VERY IMPORTANTLY, it should return the same result regardless of which reference polyline is processed first.

In my opinion, this is the first requirement for the method to be consistent.

[Steven P]

8 hours ago, PGia said:

Thank you @Steven P

The problem with creating the centerline using perpendiculars is that even in straight sections, the centerline is not equidistant perpendicularly from the reference polylines (unless the reference polylines are parallel). 

This is the method I used manually, but I didn't achieve this goal.

 

 

My one should find the centre between the shortest lines from polylines point to the other... not perpendicular so should give a reasonably curve.

[lrm]

I have enjoyed the discussion of this thread. As I gave the task more thought and anaysis it became more clear that the task was not simple. As it appears that there is still no satisfacory solution I thought I would offer the following.

 

The first goal for me was to create a function that would create a midline between two non parallel lines. The mid-lines extents should be a function of the given line segments.   This function could then be used in a program that would step through the line segments of one of the polylines and search the other polyline for relevant segments.  

 

The function "midline" accepts four points.  The first two points, A1 and A2, are the ends of one line sement while the thrid and fourth points,  B1 and B2, are the ends of an  opposing ilne segments.  The diagram below details the variables in the function.

 

The program uses vectors as I prefer them over angles which present, for me, a variety of problems. 

uA = unit vector in the diection from A1 to A2

uB = unit vector in the direction from B1 to B2

uBisector = unit vector in the direction of the angle bisector of uA and UB

 

The ends of the two lines are projected onto the bisecting line defining 4 points, A1M, A2M, B1M, B2M.

I debated which of the points to output for the line to be drawn. I first used the closest and furthest points from the intersecttion point ABIntr but I found it more helpful to use the two intermediate points  (A1M and A2M in the example above).

Here's an example of the results after manually steppng alone the polyline.

Looking at the area circled in red we find:

To fill the gap we need a curve that starts with a radius of 0.1514 and ends with a radius of 0.1693. This can be done with a spline or you may find it acceptable to extend the two lines to the point of intersection.

The best way to create the spline is to use the Control Vertex Method and use the two endpoints and the imaginary point of intersecton for the middle CV.  This ensures tangency to the two lines.  As can be seen below the distance to a random point along the spline (red) agree!

 

 

Run the program "test" and specify the end points of a line segment on one of the polylines, then the endpoints on a line segment on the opposing polyline.

 

I have found the results very accurate and although it may not be used for creating the complete "hybrid " polyline it is helpful in finding the correct line for a specific segment.

 

 

Quote

;;----------------------------------------------------------------------------
;; Determines the endpoints of a line the is midway between two lines defined by their end points.
;  Input:  4 points, the ends of the first line followed by the ens of the second line
;  Output: a list containing the two point of the midline if there's a solution and nil if no solution
;  L. Minardi 10/31/2025
(defun midLine (a1 a2 b1 b2 / ua ub p vp d s a1m a2m b1m b2m d1 d2 d3 d4 slist a1p a2p b1p b2p
		m1 m2 mmid mp)
  (setq	ua (unitVecAB a1 a2)
	ub (unitVecAB b1 b2)
  )
  (if (< (dot ua ub) 0.0)
  (setq ub (mapcar '* ub '(-1 -1 -1)))
)
  (if (> (abs (dot ua ub)) 0.9999) ; are lines parallel?
    (progn				; lines are parallel
	(setq p	  (mapcar '/ (mapcar '+ a1 b1) '(2 2 2)) ; point on midline
	      vp  (list (- (cadr ua)) (car ua) 0.0)	; vector perpendicular to ua
	      d	  (/ (dot (mapcar '- b1 a1) vp) 2.0) ; distance to midline
	      s	  (dot (mapcar '- a1 p) ua)
	      a1m (mapcar '+ p (mapcar '* ua (list s s s)))
	      s	  (dot (mapcar '- a2 p) ua)
	      a2m (mapcar '+ p (mapcar '* ua (list s s s)))
	      s	  (dot (mapcar '- b1 p) ua)
	      b1m (mapcar '+ p (mapcar '* ua (list s s s)))
	      s	  (dot (mapcar '- b2 p) ua)
	      b2m (mapcar '+ p (mapcar '* ua (list s s s)))
	      d1  0.0
	      d2  (dot ua (mapcar '- a2m a1m))
	      d3  (dot ua (mapcar '- b1m a1m))
	      d4  (dot ua (mapcar '- b2m a1m))
	)
      (setq slist ; sorted list of distances
	     (vl-sort (list (list a1m d1) (list a2m d2) (list b1m d3) (list b2m d4))
		      (function	(lambda	(e1 e2)(< (cadr e1) (cadr e2)))))
	; use the middle two mid point from the line
	(setq m1 (car (nth 1 slist))
	      m2 (car (nth 2 slist))
	)
	(setq mmid (mapcar '/ (mapcar '+ m1 m2) '(2 2 2)))
	(setq mp (* (dot (mapcar '- a1m mmid) (mapcar '- a2m mmid))))
	(if (<= mp 0)
	  (setq theLine (list m1 m2))
	  (setq theline nil)
	)
	    )
    )					; end lines parallel
    (progn				; lines are not parallel
      (setq ABIntr (inters A1 A2 B1 B2 nil))
      (setq p	      (mapcar '+ ABIntr (mapcar '/ (mapcar '+ ua ub) '(2 2 2)))
      ;(setq p	      (mapcar '+ ABIntr (mapcar '/ (mapcar '+ a1 b1) '(2 2 2)))
	    uBisector (unitVecAB ABIntr p)
	    vp	      (list (- (cadr ua)) (car ua) 0.0)
	    A1p	      (mapcar '+ A1 vp)
	    a1m	      (inters A1 A1P ABIntr p nil)
	    A2p	      (mapcar '+ A2 vp)
	    a2m	      (inters A2 A2P ABIntr p nil)
	    vp	      (list (- (cadr ub)) (car ub) 0.0)
	    B1p	      (mapcar '+ B1 vp)
	    B1m	      (inters B1 B1P ABIntr p nil)
	    B2p	      (mapcar '+ B2 vp)
	    B2m	      (inters B2 B2P ABIntr p nil)
	    d1	      (distance ABIntr a1m)
	    d2	      (distance ABIntr a2m)
	    d3	      (distance ABIntr b1m)
	    d4	      (distance ABIntr b2m)
      )
      (setq slist
	     (vl-sort (list (list a1m d1) (list a2m d2) (list b1m d3) (list b2m d4))
		      (function	(lambda	(e1 e2) (< (cadr e1) (cadr e2)))))
      )
	(setq m1 (car (nth 1 slist))
	      m2 (car (nth 2 slist))
	)
	(setq mmid (mapcar '/ (mapcar '+ m1 m2) '(2 2 2)))
	(setq mp (* (dot (mapcar '- a1m mmid) (mapcar '- a2m mmid))))
	(if (<= mp 0)
	  (setq theLine (list m1 m2))
	  (setq theline nil)
	)
    )					; end lines not parallel
  )					; end if
)


; test function
(defun c:test ( / a1 a2 b1 b2 mline )
(setq a1    (getpoint "\nEnter start point of first line: ")
      a2    (getpoint a1 "\nEnter end point of first line: ")
      b1    (getpoint "\nEnter start point of second line: ")
      b2    (getpoint b1 "\nEnter end point of second line: ")
      mline (midline a1 a2 b1 b2)
)
(if mline
  (command "_line" "_non" (car mline) "_non" (cadr mline) "")
  (princ "\nNo Solution!")
)
  (princ)
)  


; unit vector from point A to point B
(defun unitVecAB (A B / x)
  (setq	x (distance A B)
	x (mapcar '/ (mapcar '- B A) (list x x x))
  )
)
; dot product of vectors A and B
(defun dot (A B / x)
  (setq x (mapcar '* A B))
  (setq x (+ (nth 0 x) (nth 1 x) (nth 2 x)))
);end of dot