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]

Edited

 

Not quite there yet, will draw points at the mid points between each coordinate in the polylines and the closest point in the other. Draws a poly line connecting most of them... but not quite... Something odd if you select the polylines in the wrong order.

 

Results are similar to what others have. No account taken for arcs yet

 

 

(defun c:PolyMD ( / acount MyPoly1 MypolyEnt1 MyPolyVert1 MyPoly2 MypolyEnt2 MyPolyVert2 pt pt1 pt2 PtList1 PtList2 pnt NewPoly NewPolyEnt)

;;; Sub functions ;;;;;;

;;https://www.cadtutor.net/forum/topic/87445-help-add-vertex-to-polyline/
(defun add_vtx (obj add_pt ent_name / sw ew nw bulg)
  (vla-GetWidth obj (fix add_pt) 'sw 'ew)
  (vla-addVertex obj
    (1+ (fix add_pt))
    (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1))
        (list
          (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
          (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
        )
      )
    )
  )
  (setq
    nw
    (*
      (/
        (- ew sw)
        (- (vlax-curve-getdistatparam obj (1+ (fix add_pt))) (vlax-curve-getdistatparam obj (fix add_pt)))
      )
      (- (vlax-curve-getdistatparam obj add_pt) (vlax-curve-getdistatparam obj (fix add_pt)))
    )
    bulg (atan (vla-GetBulge obj (fix add_pt)))
  )
  (vla-SetBulge obj
    (fix add_pt)
    (/
      (sin (* 4 bulg (- add_pt (fix add_pt)) 0.25))
      (cos (* 4 bulg (- add_pt (fix add_pt)) 0.25))
    )
  )
  (vla-SetBulge obj
    (1+ (fix add_pt))
    (/
      (sin (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
      (cos (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
    )
  )
  (vla-SetWidth obj
    (fix add_pt)
    sw
    (+ nw sw)
  )
  (vla-SetWidth obj
    (1+ (fix add_pt))
    (+ nw sw)
    ew
  )
  (vla-update obj)
)
(defun add_vtx@point (ename lst_pt / n ename obj dxf_10 pt_brk l_tst)
  (setq obj (vlax-ename->vla-object ename))
  (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ename))))
  (foreach el (mapcar '(lambda (x) (trans x 0 ename)) lst_pt)
    (setq pt_brk (trans (vlax-curve-getClosestPointTo ename (trans el ename 0) nil) 0 ename))
    (setq l_tst (vl-member-if '(lambda (x) (and (equal (car x) (car pt_brk) 1E-08) (equal (cadr x) (cadr pt_brk) 1E-08))) dxf_10))
    (if
      (and
        (equal pt_brk el 1E-08)
        (not (eq (length l_tst) 1))
        (not (eq (length l_tst) (length dxf_10)))
      )
      (progn
        (setq lst_brk (cons pt_brk lst_brk))
        (if (zerop (length l_tst))
          (add_vtx obj (vlax-curve-getparamatpoint ename (trans pt_brk ename 0)) ename)
        )
      )
    )
  )
)


  (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 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 MakePoly (PtLst PolyClose / )
(princ "Close: ")(princ PolyClose)

     (entmakex (append
         (list
           (cons 0 "LWPOLYLINE")
           (cons 100 "AcDbEntity")
           (cons 100 "AcDbPolyline")
           (cons 90 (length PtLst))
;;           (cons 70 PolyClose)
         )
         (mapcar (function (lambda (p) (cons 10 p))) PtLst)
    ))
  )
  (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)
    ))
  )
;;;;;;; end sub functions ;;;;;;;



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

  (foreach pt MyPoly1Vert
    (setq pt2 (vlax-curve-getclosestpointto MyPoly2 pt))
    (setq PtList1 (cons (midpt pt pt2) PtList1))
  ) ; end foreach
  (setq NewPoly (MakePoly PtList1 (cdr (assoc 70 MyPoly1Ent))))
  (setq NewPolyEnt (entget NewPoly))

  (foreach pt MyPoly2Vert
    (setq pt1 (vlax-curve-getclosestpointto MyPoly1 pt))
    (setq NewLine (makeline pt pt1))
    (setq PtList2 (cons (midpt pt pt1) PtList2))

(setq pnt (car (LM:intersections (vlax-ename->vla-object NewLine) (vlax-ename->vla-object NewPoly) acextendnone)))

    (setq pnt (list (car pnt) (cadr pnt)))
    (add_vtx@point NewPoly (list pnt))
    (setq NewPolyEnt (entget NewPoly))
    (setq NewPolyEnt (subst (cons 10 (midpt pt pt1) ) (cons 10 pnt) NewPolyEnt ))
    (entmod NewPolyEnt)
;;    (entupd NewPoly)
    (command "erase" NewLine "")

  ) ; end foreach

  (foreach pt PtList1 (Makepoint pt) )
  (foreach pt PtList2 (Makepoint pt) )

;;Work out if midpoints outside of exterior polyline (in case of complicated shapes)
;;Work out polyline bulges
;;If closed poly, add end vertex
  (princ)
 )

 

Edited Saturday at 10:52 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 Friday 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

 

 

[GLAVCVS]

I also think this thread has been stimulating.

The final result should be useful for other users in the future.

Regarding your approach, I agree; it's the best way to achieve an axis with perfectly centered segments.

All that remains is to write the code that can do all of that without Express Tools.

[SLW210]

Hopefully I can get back to my LISP today.

 

I did do some experiments with CENTERLINE command in newer AutoCAD (not sure when it was first available), if just Polylines/lines, it gets the center very accurately, good for checking a LISP IMO. 

 

This is really a job for Civil 3D/ArcGIS or similar software.

 

 

 

 

[GLAVCVS]

On 10/30/2025 at 11:56 AM, SLW210 said:

 

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.

 

 

As for the code from my first attempt, I suppose the least I should do for any “child of mine” is to make sure it can have a functional life, no matter how cross-eyed it was born: you never abandon a child.

So here I leave a new version of “GLAVCVS’ cross-eyed child”, fresh out of the hospital.

 

;|        G L A V C V S  C R O S S - E Y E D   C H I L D         
                              - o -                              
************************* G L A V C V S *************************
*************************** F E C I T ***************************|;
(defun c:creAxis (/ e e1 e2 l i? l1 l2 lr p p0 p1 p2 px pm abis lii pmi pmf pi1 pi2 pf1 pf2 pc1 pc2 li1 o dameInters+Prox ordena decide sustituye damePuntos)
  (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 (po px pm / p0 lr)
    (foreach p lii
      (if (and p0 (inters po px p0 p))
	(setq lr (append lr (list pm)))
      )
      (setq p0 p lr (append lr (list p)))
    )
  )
  
  (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
	)
	(cond
	  ((= (rem (cdr (assoc 70 l1)) 2) 1)
	   (setq lp1 (append lp1 (list (car lp1) (cadr lp1) (caddr lp1))))
	  )
	  ((equal (car lp1) (last lp1))
	   (setq lp1 (append lp1 (list (cadr lp1) (caddr lp1))))
	  )
	  (T
	   (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car lp1) (setq pc1 (vlax-curve-getClosestPointTo e2 (car lp1))))
		 pmf (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (last lp1) (setq pc2 (vlax-curve-getClosestPointTo e2 (last lp1))))
	   )
	  )
	)
	(cond
	  ((= (rem (cdr (assoc 70 l2)) 2) 1)
	   (if pmi
	     (progn
	       (foreach p (append lp2 (list (car lp2)))
	         (if (or (equal p pmi 1e-4) (equal p pmf 1e-4))
		   (setq l (if l (not (setq lr (append l (list p)))) (list (list p))))
		   (if l (setq l (append l (list p))))
		 )
	       )
	       (setq lp2 lr lr nil l nil)
	     )
	     (setq lp2 (append lp2 (list (car lp2) (cadr lp2))))
	   )
	  )
	  ((equal (car lp2) (last lp2))
	   (if pc1
	     (progn
	       (foreach p lp2
	         (if (or (equal p pc1 1e-4) (equal p pc2 1e-4))
		   (setq l (if l (not (setq lr (append l (list p)))) (list (list p))))
		   (if l (setq l (append l (list p))))
	         )
	       )
	       (setq lp2 lr lr nil l nil)
	     )
	     (setq lp2 (append lp2 (list (cadr lp2))))
	   )
	  )
	)
	
	(redraw e1 4)
	(redraw e2 4)

	(foreach lp (list lp1 lp2)
	  (foreach l lp
	    (if p1
	      (if p2
	        (setq abis (+ (/ (+ (angle p1 p2) (angle p2 l)) 2) (/ PI 2.))
		      px (dameInters+Prox p2 abis (if o lp1 lp2))
		      lr nil
		      pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px))
		      lii (if o (if pm (ordena p2 px pm) lii) (if px (append lii (list pm)) lii))
		      p1 p2
		      p2 l
	        )
	        (setq p2 l)
	      )
	      (setq p1 l)
	    )
	  )
          (if pmi (setq lii (append (list pmi) lii (list pmf))))
          (setq p1 nil p2 nil lr nil o T)
	)
      )
    )
  )
  (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)
)

 

[SLW210]

I have improved mine somewhat, at least it's the same no matter the pick order. Still working on a better method for correct centerline. Looks pretty close most of the time and should work with LWPolylines and Old Style Polylines and should handle bulges.

 

I finished this at work, so untested on AutoCAD 2000i at home, so just AutoCAD 2026.

 

;;; Draws a centerline between two polylines.                                             |
;;;                                                                                       |
;;; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/3/#findComment-677003 |
;;;                                                                                       |
;;; By SLW210 (a.k.a. Steve Wilson)                                                       |
;;;                                                                                       |
;;;=======================================================================================|
;;; DrawCl.LSP                                                                            |
;;; Create centerline between two polylines                                               |
;;; on layer Centerline, color Blue, and linetype Center                                  |
;;;=======================================================================================|

(vl-load-com)

;;; -------------------------------
;;; Vector midpoint
;;; -------------------------------
(defun v-mid (a b)
  (list (/ (+ (car a) (car b)) 2.0)
        (/ (+ (cadr a) (cadr b)) 2.0))
)

;;; -------------------------------
;;; Distance squared
;;; -------------------------------
(defun dist2 (a b)
  (+ (expt (- (car a) (car b)) 2)
     (expt (- (cadr a) (cadr b)) 2))
)

;;; -------------------------------
;;; Nearest point
;;; -------------------------------
(defun nearest (pt lst / best d cur)
  (setq best nil d 1e99)
  (foreach cur lst
    (if (< (dist2 pt cur) d)
      (setq d (dist2 pt cur)
            best cur)))
  best
)

;;; --------------------------------------------------
;;; Get polyline vertices (LWPOLYLINE or old POLYLINE)
;;; --------------------------------------------------
(defun get-poly-pts (ename / elist pts cur)
  (setq elist (entget ename))
  (cond
    ((= "LWPOLYLINE" (cdr (assoc 0 elist)))
     (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) elist)))
    ((= "POLYLINE" (cdr (assoc 0 elist)))
     (setq pts '()
           cur (entnext ename))
     (while cur
       (setq elist (entget cur))
       (cond
         ((= "VERTEX" (cdr (assoc 0 elist)))
          (setq pts (cons (cdr (assoc 10 elist)) pts)))
         ((= "SEQEND" (cdr (assoc 0 elist))) (setq cur nil)))
       (if cur (setq cur (entnext cur))))
     (reverse pts))
    (T (progn (princ "\nEntity is not a polyline.") nil)))
)

;;; -----------------------------------------
;;; Polyline length (sum of vertex distances)
;;; -----------------------------------------
(defun polyline-length (pts / total i)
  (if (< (length pts) 2)
    0
    (progn
      (setq total 0.0 i 0)
      (while (< i (1- (length pts)))
        (setq total (+ total (sqrt (dist2 (nth i pts) (nth (1+ i) pts)))))
        (setq i (1+ i)))
      total)))
      
;;; -------------------------------
;;; Polyline selection helper
;;; -------------------------------
(defun select-polyline (pick / sel)
  (while (progn
           (setq sel (entsel pick))
           (not (and sel (entget (car sel)))))
    (princ "\nPlease select a valid polyline."))
  (car sel))

;;; -------------------------------
;;; Ensure Centerline Layer Exists
;;; -------------------------------
(defun ensure-centerline-layer (/ doc layers layerObj ltObj)
  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq layers (vla-get-Layers doc))
  (setq ltypes (vla-get-Linetypes doc))
  
  ;; Load CENTER linetype if needed
  (if (not (tblsearch "LTYPE" "CENTER"))
    (vl-catch-all-apply
      '(lambda ()
         (vla-load ltypes "CENTER" "acad.lin"))))

  ;; Create layer if missing
  (if (not (tblsearch "LAYER" "Centerline"))
    (setq layerObj (vla-Add layers "Centerline"))
    (setq layerObj (vla-Item layers "Centerline")))

  ;; Set layer properties
  (vla-put-Color layerObj 5) ; blue
  (if (tblsearch "LTYPE" "CENTER")
    (vla-put-Linetype layerObj "CENTER"))
  
  layerObj
)

;;; -------------------------------
;;; Main DRAWCL command
;;; -------------------------------
(defun c:DRAWCL (/ e1 e2 pts1 pts2 ref tgt mids coords arr doc ms pline closest closed layerObj)
  (vl-load-com)
  (princ "\nStarting DRAWCL centerline routine...")

  ;; Select polylines
  (setq e1 (select-polyline "\nSelect first polyline: "))
  (setq e2 (select-polyline "\nSelect second polyline: "))

  ;; Get vertices
  (setq pts1 (get-poly-pts e1))
  (setq pts2 (get-poly-pts e2))

  (if (and pts1 pts2)
    (progn
      ;; Determine longer polyline as reference
      (if (> (polyline-length pts1) (polyline-length pts2))
        (setq ref pts1 tgt pts2 eRef e1)
        (setq ref pts2 tgt pts1 eRef e2))

      ;; Compute centerline midpoints
      (setq mids '())
      (foreach pt ref
        (setq closest (nearest pt tgt))
        (setq mids (cons (v-mid pt closest) mids)))
      (setq mids (reverse mids))

      ;; Ensure Centerline layer and linetype exist
      (setq layerObj (ensure-centerline-layer))

      ;; Create centerline polyline in model space
      (if (> (length mids) 1)
        (progn
          (setq coords (apply 'append (mapcar '(lambda (p) (list (car p) (cadr p))) mids)))
          (setq arr (vlax-make-safearray vlax-vbDouble (cons 0 (- (* 2 (length mids)) 1))))
          (vlax-safearray-fill arr coords)
          (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
          (setq ms (vla-get-ModelSpace doc))
          (setq pline (vla-AddLightWeightPolyline ms arr))
          
          ;; Match closed/open status
          (setq closed (= 1 (logand 1 (cdr (assoc 70 (entget eRef))))))
          (vla-put-Closed pline (if closed :vlax-true :vlax-false))
          
          ;; Assign layer
          (vla-put-Layer pline "Centerline")
          
          (princ "\nCenterline created successfully on layer 'Centerline'."))
        (princ "\nNot enough points to create centerline.")))
    (princ "\nFailed to get polyline vertices."))

  (princ)
)

 

Most Civil software has this in it and works pretty good AFAIK most of the time, it's not using LISP.

 

It might be the harder, but maybe for new AutoCAD using CENTERLINE command with automated trimming and Join and Close if needed might be best for accuracy.