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 yesterday 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 47 minutes ago by Steven P