Leaderboard

Nice test case @PGia, it did have some undesirable zigzags on those lines. I made some changes to the code to prevent this from happening. It should create a smooth line again!

@PGia Thanks for the encouragement and checking the results. I measure from the vertices instead of the lines. Those are calculated and the lines are just to connect the points. So perpendicular to the middle of segments of the centerline will always be a bit off, but if you measure from the vertices it should be centered correctly. Just like @GP_ said. I kept going in the same direction and I have made some improvements and got rid of some bugginess: The centerline should be a little more accurate now because of extra measurements (blue line) Crossing polylines get sharp corners on negative side Corner checks are done on all intersections of temporary line now (red line) More error checking so it doesn't crash on some of the example lines I left all of the 'animation' code commented out so you can give it a try ;| ; Calculate centerline between two polylines - dexus ; Function checks intersections of the offsets of two lines to create a middle/avarage line. ; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/6/#findComment-677339 ; Version 0.1 - Initial release 19-11-2025 ; Version 0.2 - Added corner support on negative side of crossing polylines 27-11-2025 ; Version 0.3 - Extra check using vertex to closest point as distance 28-11-2025 ; Version 0.4 - Added error function 28-11-2025 ; Version 0.5 - Improved distance check to prevent zigzag lines 01-12-2025 ; Version 0.6 - Check if offset can be used before adding points 01-12-2025 ; Version 0.7 - Improved side check on 3 points 01-12-2025 ; Version 0.8 - Don't compare startpoint to offset when eiter of the polylines is closed 04-12-2025 ; Version 0.9 - Add points for parallel end segments and set offsetgaptype 05-12-2025 |; (defun c:cpl (/ corners ent1 ent2 enx2 flipped gap loop maxlen offset offsetdistance parallel pts sides ss start te0 te1 te2 LM:ProjectPointToLine LM:intersections _addPoints _avarageAngle _checkOffset _cornerOffset _doOffset _getAnglesAtParam _getLength _polyline _rlw _side _wait *error*) (defun *error* (st) (if (wcmatch (strcase st t) "*break,*cancel*,*exit*") (redraw) (progn (vl-bt) (princ (strcat "\nOops! Something went wrong: ") st) ) ) (if (and te0 (not (vlax-erased-p te0))) (entdel te0)) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) (princ) ) ;| ; Draw Polyline - dexus ; Draw a polyline from a list of points, but filter out colinear points ; @Param lst list of points ; @Returns ename of polyline |; (defun _polyline (lst closed / prev pts) (while lst (cond ( (and (cdr lst) prev (or (equal (cdr lst) prev 1e-8) ; Remove duplicate points (null (inters prev (car lst) prev (cadr lst))) ; Remove collineair points ) ) ) ((setq pts (cons (cons 10 (setq prev (car lst))) pts))) ) (setq lst (cdr lst)) ) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 (if closed 1 0)) ) (reverse 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)) (vlax-curve-getDistAtParam ent (vlax-curve-getStartParam ent)) ) ) (defun _wait (msec) (not ( (lambda (start) (while (< (- (getvar 'millisecs) start) msec)) ) (getvar 'millisecs) ) ) ) (defun _addPoints (lst ent1 ent2 pts / len1 len2) (setq len1 (_getLength ent1) len2 (_getLength ent2) lst (vl-remove nil (mapcar (function (lambda (pt / d1 d2) (if (and (setq d1 (vlax-curve-getDistAtPoint ent1 pt)) (setq d2 (vlax-curve-getDistAtPoint ent2 pt)) ) (list (cond ((and (vlax-curve-isclosed ent1) (not (vlax-curve-isclosed ent2))) (/ d2 len2)) ((vlax-curve-isclosed ent2) (/ d1 len1)) ((+ (/ d1 len1) (/ d2 len2))) ) pt ) ) )) lst ) ) pts (append lst pts)) ; Animation ; (setq pts (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) ; (redraw) ; (foreach pt lst ; (tmpPoint (cadr pt) 1 1) ; ) ; ( ; (lambda (lst) ; (while (cadr lst) ; (grdraw (cadar lst) (cadar (setq lst (cdr lst))) 3) ; ) ; ) ; pts ; ) ; (vla-update ent1) ; (_wait 40) ; End animation pts ) (defun _checkOffset (ent1 ent2 offset) (or (vlax-curve-isclosed ent1) (vlax-curve-isclosed ent2) (and (equal (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getStartPoint ent2)) offset 1e-4) (equal (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) offset 1e-4) ) ) ) (defun _doOffset (offset / lst rtn) ; Global vars: pts ent1 ent2 sides te1 te2 (setq te1 nil) (setq te2 nil) (setq rtn (cond ((equal offset 0.0 1e-8) (if (setq lst (LM:intersections ent1 ent2 acExtendNone)) (setq pts (_addPoints lst ent1 ent2 pts)) ) lst ) ( (or ; Make offset (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if (car sides) offset (- offset)))))) (cdr te1) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if (cadr sides) offset (- offset)))))) (cdr te2) (not (_checkOffset ent1 (car te1) offset)) (not (_checkOffset ent2 (car te2) offset)) (vla-put-visible (car te1) :vlax-false) (vla-put-visible (car te2) :vlax-false) ) (princ "\nOffset failed. ") nil ) ((setq lst (LM:intersections (car te1) (car te2) acExtendNone)) (if parallel ; Add points of parallel end segments (mapcar (function (lambda (ent1 ent2) (mapcar (function (lambda (pt) (if (equal pt (vlax-curve-getClosestPointTo ent2 pt) 1e-10) (setq lst (cons pt lst)) ) )) (list (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1) ) ) )) (list (car te1) (car te2)) (list (car te2) (car te1)) ) ) (setq pts (_addPoints lst (car te1) (car te2) pts)) lst ) ) ) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) rtn ) ;| ; Project Point onto Line - Lee Mac ; @Param pt point to project ; @Param p1 first point of line ; @Param p2 second point of line ; @Returns projected point |; (defun LM:ProjectPointToLine ( pt p1 p2 / nm ) (setq nm (mapcar '- p2 p1) p1 (trans p1 0 nm) pt (trans pt 0 nm)) (trans (list (car p1) (cadr p1) (caddr pt)) nm 0) ) (defun _getAnglesAtParam (ent pa / ang1 ang2) (if (and (vlax-curve-isClosed ent) (= pa 0)) ; Special case for closed Polyline (setq ang1 (vlax-curve-getFirstDeriv ent 1e-14) ang2 (vlax-curve-getFirstDeriv ent (- (fix (vlax-curve-getEndParam ent)) 1e-14))) (setq ang1 (vlax-curve-getFirstDeriv ent (+ pa 1e-14)) ang2 (vlax-curve-getFirstDeriv ent (- pa 1e-14))) ) (if (and ang1 ang2) (list (angle '(0 0 0) ang1) (angle '(0 0 0) ang2) ) ) ) ;| ; Avarage Angle - dexus ; Get angle of a line between two angles ; @Param ang1 real - Angle in radians ; @Param ang2 real - Angle in radians ; @Returns real - Angle in radians |; (defun _avarageAngle (ang1 ang2) (if (< (rem (+ ang1 pi) (+ pi pi)) (rem (+ ang2 pi) (+ pi pi)) ) (+ (* (- ang2 ang1) 0.5) ang1) (+ (* (- ang1 ang2) 0.5) ang2) ) ) ;| ; Calculate exact offset distance on a corner - dexus ; pt1 - Point on corner ; pt2 - Point on other side ; pt3 - Center for bisector ; pt4 - Target for corner of the offset ; pt5 - Find perpendicular point for offset distance ; / ; / ; -------- pt1 pt5 ; \ / ; pt4 ; \ ; ---- pt3 ----- pt2 ----- ; ; @Param ent1 Line to check corners ; @Param ent2 Opposing line ; @Returns List of offset distances (pt1 -> pt5) to calculate |; (defun _cornerOffset (ent1 ent2 / ang1 ang1a ang2 ang3 index pt1 pt2 pt3 pt4 pt5 rtn) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (and (setq pt1 (vlax-curve-getPointAtParam ent1 index)) ; Point on corner (setq ang1 (_getAnglesAtParam ent1 index)) ; Angles of pt1 (setq ang1a (_avarageAngle (car ang1) (cadr ang1))) (setq te0 (entmakex (list (cons 0 "line") (cons 10 pt1) (cons 11 (polar pt1 (- ang1a halfPi) 1))))) ; Temp line for finding the angle on the other side (foreach pt2 (LM:intersections (vlax-ename->vla-object te0) ent2 acExtendThisEntity) ; Point on other side (and (setq ang2 (_getAnglesAtParam ent2 (vlax-curve-getParamAtPoint ent2 pt2))) ; Angle of pt2 (if (equal (rem (car ang1) pi) (rem (car ang2) pi) 1e-8) ; Is parallel? (and (setq parallel (or parallel (< index 1) (<= (fix (vlax-curve-getEndParam ent1)) (1+ index)) t)) (setq pt3 (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt1 pt2)) ; Midpoint (setq ang3 (car ang1)) ; Same angle als ang1 ) (and (setq pt3 (inters pt1 (polar pt1 (car ang1) 1) pt2 (polar pt2 (car ang2) 1) nil)) ; Find center for bisector (setq ang3 (_avarageAngle (angle pt1 pt3) (angle pt2 pt3))) ; Angle of bisector ) ) (setq pt4 (inters pt3 (polar pt3 ang3 1) pt1 (polar pt1 (+ ang1a halfPi) 1) nil)) ; Find target for corner of the offset (setq pt5 (LM:ProjectPointToLine pt4 pt1 (polar pt1 (+ (car ang1) halfPi) maxlen))) ; Find perpendicular point for offset distance (setq rtn (cons (distance pt1 pt5) rtn)) ; Return offset distance ; Animation ; (progn ; (redraw) ; (grdraw pt1 pt2 1) ; (grdraw pt4 pt5 2) ; (grdraw pt1 pt5 2) ; (grdraw pt2 pt5 2) ; (vla-update ent1) ; (_wait 120) ; ) ; End Animation ) ) ) (if (and te0 (not (vlax-erased-p te0))) (entdel te0)) (setq index (1+ index)) ) rtn ) (defun _rlw (lw / x1 x2 x3 x4 x5 x6) (if (and lw (= (cdr (assoc 0 lw)) "LWPOLYLINE")) (progn (foreach a1 lw (cond ((= (car a1) 10) (setq x2 (cons a1 x2))) ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4))) ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3))) ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5))) ((= (car a1) 210) (setq x6 (cons a1 x6))) (t (setq x1 (cons a1 x1))) ) ) (append (reverse x1) (append (apply (function append) (apply (function mapcar) (cons 'list (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) )) )) x6) ) ) ) ) (if (and (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 enx2 (entget ent2)) (setq ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) ent1 ent2 ) (progn (and (< (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent2)) (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) ) (setq flipped t) (entmod (_rlw enx2)) ) (setq sides (mapcar (function (lambda (a b / s m e) (setq s (_side a (vlax-curve-getStartPoint b)) m (_side a (vlax-curve-getPointAtParam b (* 0.5 (vlax-curve-getEndParam b)))) e (_side a (vlax-curve-getEndPoint b))) (or (and s m) (and s e) (and m e)) )) (list ent1 ent2) (list ent2 ent1) ) ) (if (not (numberp halfPi)) (setq halfPi (* pi 0.5))) (setq maxlen (* 1.1 (max (_getLength ent1) (_getLength ent2) ( (lambda (ent1 ent2 / step de1 div p_step dis dmax) (setq step (/ (setq de1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1))) 500) div step dmax 0.00) (while (< div de1) (setq p_step (vlax-curve-getPointAtDist ent1 div) dis (distance p_step (vlax-curve-getClosestPointTo ent2 p_step))) (if (> dis dmax) (setq dmax dis)) (setq div (+ div step)) ) dmax ) ent1 ent2 ) ) ) ) (mapcar ; Add half distances from closest point to every vertex (function (lambda (ent1 ent2 / index pt) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (setq pt (vlax-curve-getPointAtParam ent1 index) corners (cons (* (distance pt (vlax-curve-getClosestPointTo ent2 pt)) 0.5) corners) index (1+ index)) ; Animation ; (redraw) ; (grdraw pt (vlax-curve-getClosestPointTo ent2 pt) 4) ; ( ; (lambda (mid) (grdraw mid (polar mid (+ (angle pt (vlax-curve-getClosestPointTo ent2 pt)) halfPi) (car corners)) 2)) ; (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt (vlax-curve-getClosestPointTo ent2 pt)) ; ) ; (vla-update ent1) ; (_wait 120) ; End animation ) )) (list ent1 ent2) (list ent2 ent1) ) (setq corners (vl-sort (append corners (_cornerOffset ent1 ent2) (_cornerOffset ent2 ent1)) '<) offsetdistance (/ maxlen 512.0)) (if (LM:intersections ent1 ent2 acExtendNone) ; For crossing polylines, add negative values (setq offset (- maxlen) corners (append (mapcar '- (reverse corners)) corners)) (setq offset 0.0) ) (setq gap (getvar 'offsetgaptype)) (setvar 'offsetgaptype 0) (while (progn (while (and corners (> offset (car corners))) ; Calculated offset values to check (_doOffset (car corners)) (setq corners (cdr corners)) ) (setq loop ; Incremental check (cond ((> offset maxlen) nil) ((_doOffset offset) (setq start t)) ((not start) t) (start nil) ) ) (setq offset (+ offset offsetdistance)) loop ) ) (setvar 'offsetgaptype gap) (if flipped (entmod enx2)) (if pts ; Draw polyline (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) (and (vlax-curve-isClosed ent1) (vlax-curve-isClosed ent2)) ) ) ) ) (redraw) (princ) ) And here is an animation of it working just because they are fun to look at :

I copied another function of dijkstra's algorithm to find the shortest path. It might need a lot of optimization, but just as a proof of concept. centerline voronoi dijkstra.lsp Code I forgot to include: (defun RemoveDuplicatesAux ( x ) (cond ((vl-position x index)) ((null (setq index (cons x index)))) ) ) (defun RemoveDuplicates ( lst / index ) (vl-remove-if 'RemoveDuplicatesAux lst ) )

I added extra checks on every vertex like @PGia suggested two weeks ago. Those I added to the offset-loop and it gives the best of both worlds. Every point that is calculated should be the exact middle because the offset is the same on both sides. Still not perfect, but pretty close I think. ;| ; Calculate centerline between two polylines - dexus ; Function checks intersections of the offsets of two lines to create a middle/avarage line. |; (defun c:cl (/ ent1 ent2 loop maxlen offset offsetdistance pts s1 s2 ss start LM:ProjectPointToLine LM:intersections _addPoints _avarageAngle _cornerOffset _doOffset _getAnglesAtParam _getLength _polyline _side _wait) ;| ; Draw Polyline - dexus ; Draw a polyline from a list of points, but filter out colinear points ; @Param lst list of points ; @Returns ename of polyline |; (defun _polyline (lst / prev pts) (while lst (cond ((and (cdr lst) prev (null (inters prev (car lst) prev (cadr lst))))) ((setq pts (cons (cons 10 (setq prev (car lst))) pts))) ) (setq lst (cdr lst)) ) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 0) ) (reverse pts) ) ) ) (defun _side (pline pnt / cpt end target der) (setq cpt (vlax-curve-getClosestPointTo pline pnt) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 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)) (vlax-curve-getDistAtParam ent (vlax-curve-getStartParam ent)) ) ) (defun _wait (msec) (not ( (lambda (start) (while (< (- (getvar 'millisecs) start) msec)) ) (getvar 'millisecs) ) ) ) (defun _addPoints (lst ent pts / len) (setq len (_getLength ent)) (setq lst (mapcar (function (lambda (pt) (list (/ (vlax-curve-getDistAtPoint ent pt) len) pt))) lst)) (setq pts (append lst pts)) ; Animation ; (setq pts (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) ; (redraw) ; ( ; (lambda (lst) ; (while (cadr lst) ; (grdraw (cadar lst) (cadadr lst) 3) ; (setq lst (cdr lst)) ; ) ; ) ; pts ; ) ; (vla-update ent) ; (_wait 40) ; End animation pts ) (defun _doOffset (offset / te1 te2 lst rtn) ; Global vars: pts ent1 ent2 s1 s2 (setq rtn (cond ((equal offset 0.0 1e-4) (if (setq lst (LM:intersections ent1 ent2 acExtendNone)) (setq pts (_addPoints lst ent1 pts)) ) lst ) ( (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)))))) (vla-put-color (car te1) 252) (vla-put-color (car te2) 252) ) (princ "\nOffset failed. ") nil ) ((setq lst (LM:intersections (car te1) (car te2) acExtendNone)) (setq pts (_addPoints lst (car te1) pts)) lst ) ) ) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) rtn ) ;| ; Project Point onto Line - Lee Mac ; @Param pt point to project ; @Param p1 first point of line ; @Param p2 second point of line ; @Returns projected point |; (defun LM:ProjectPointToLine ( pt p1 p2 / nm ) (setq nm (mapcar '- p2 p1) p1 (trans p1 0 nm) pt (trans pt 0 nm)) (trans (list (car p1) (cadr p1) (caddr pt)) nm 0) ) (defun _getAnglesAtParam (ent pa / ang1 ang2) (if (and (vlax-curve-isClosed ent) (= pa 0)) ; Special case for closed Polyline (list (setq ang1 (vlax-curve-getFirstDeriv ent 1e-14)) (setq ang2 (vlax-curve-getFirstDeriv ent (- (fix (vlax-curve-getEndParam ent)) 1e-14))) ) (list (setq ang1 (vlax-curve-getFirstDeriv ent (+ pa 1e-14))) (setq ang2 (vlax-curve-getFirstDeriv ent (- pa 1e-14))) ) ) (setq ang1 (angle '(0 0 0) ang1)) (setq ang2 (angle '(0 0 0) ang2)) (list ang1 (* (+ ang1 ang2) 0.5) ang2) ) ;| ; Avarage Angle - dexus ; Get angle of a line between two angles ; @Param ang1 real - Angle in radians ; @Param ang2 real - Angle in radians ; @Returns real - Angle in radians |; (defun _avarageAngle (ang1 ang2) (if (< (rem (+ ang1 pi) (+ pi pi)) (rem (+ ang2 pi) (+ pi pi)) ) (+ (* (- ang2 ang1) 0.5) ang1) (+ (* (- ang1 ang2) 0.5) ang2) ) ) ;| ; Calculate exact offset distance on a corner - dexus ; pt1 - Point on corner ; pt2 - Point on other side ; pt3 - Center for bisector ; pt4 - Target for corner of the offset ; pt5 - Find perpendicular point for offset distance ; / ; / ; -------- pt1 pt5 ; \ / ; pt4 ; \ ; ---- pt3 ----- pt2 ----- ; ; @Param ent1 Line to check corners ; @Param ent2 Opposing line ; @Returns List of offset distances (pt1 -> pt5) to calculate |; (defun _cornerOffset (ent1 ent2 / ang1 ang2 ang3 index pt1 pt2 pt3 pt4 pt5 rtn tmp vertex) (setq vertex (fix (vlax-curve-getEndParam ent1)) halfPi (* pi 0.5) index 0) (repeat vertex (and (setq pt1 (vlax-curve-getPointAtParam ent1 index)) ; Point on corner (setq ang1 (_getAnglesAtParam ent1 index)) ; Angles of pt1 (setq tmp ; Temp line for finding the angle on the other side (entmakex (list '(0 . "line") (cons 10 (polar pt1 (+ (cadr ang1) halfPi) maxlen)) (cons 11 (polar pt1 (- (cadr ang1) halfPi) maxlen)) ) ) ) (setq pt2 (car (LM:intersections (vlax-ename->vla-object tmp) ent2 acExtendNone))) ; Point on other side (setq ang2 (_getAnglesAtParam ent2 (vlax-curve-getParamAtPoint ent2 pt2))) ; Angle of pt2 (if (equal (rem (car ang1) pi) (rem (car ang2) pi) 1e-9) ; Is parallel? (and (setq pt3 (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt1 pt2)) ; Midpoint (setq ang3 (car ang1)) ; Same angle als ang1 ) (and (setq pt3 (inters pt1 (polar pt1 (car ang1) 1) pt2 (polar pt2 (car ang2) 1) nil)) ; Find center for bisector (setq ang3 (_avarageAngle (angle pt1 pt3) (angle pt2 pt3))) ; Angle of bisector ) ) (setq pt4 (inters pt3 (polar pt3 ang3 1) pt1 (polar pt1 (+ (cadr ang1) halfPi) 1) nil)) ; Find target for corner of the offset (setq pt5 (LM:ProjectPointToLine pt4 pt1 (polar pt1 (+ (car ang1) halfPi) maxlen))) ; Find perpendicular point for offset distance (setq rtn (cons (distance pt1 pt5) rtn)) ; Return offset distance ) (if (entget tmp) (entdel tmp)) (setq index (1+ index)) ) rtn ) (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 (* 1.1 (max (_getLength ent1) (_getLength ent2) (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getStartPoint ent2))))) (setq offsetdistance (/ maxlen 1024.0)) (if (LM:intersections ent1 ent2 acExtendNone) (setq offset (- maxlen)) (setq offset 0.0) ) (mapcar '_doOffset (_cornerOffset ent1 ent2)) (mapcar '_doOffset (_cornerOffset ent2 ent1)) (while (progn (setq loop (cond ((> offset maxlen) nil) ((_doOffset offset) (setq start t)) ((not start) t) (start nil) ) ) (setq offset (+ offset offsetdistance)) loop ) ) (if pts (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b))))))) ) ) ) (redraw) (princ) )

Here I've revised Helmut's code and made it faster. ;; ; ;; Pathfinding with the A* algorithm by ymg 22/07/2024 ; ;; ; ;; Revised a prog by HELMUT SCHRÖDER - heschr@gmx.de - 2014-09-14 ; ;; found at Cadtutor.net ; ;; ; ;; Kept the same format for edges list but added lines as valid choice ; ;; Format: (((x1 y1) (x2 y2)) (((x2 y2) (x3 y3))....(xn yn))) ; ;; ; ;; The user is asked to pick a start and an endpoint. ; ;; The program will find the shortest path in a network of connected ; ;; polylines and/or lines and draw a new polyline representing the result. ; ;; ; ;; Two lists of nodes openlst and closelst are created from the above ; ;; mentionned edges list. The format of a node list is: ; ;; (((Point) (Prev Point) Cumulated_Distance Estimated_Total_Distance)...) ; ;; ; ;; Main change from origina are: ; ;; - cons the list instead of append ; ;; - vl-sort the openlist instead of the quicksort ; ;; - Replaced and renamed some vars and subroutine. ; ;; - Added fuzz 1e-4 to all points comparison ; ;; - Change the get_path function ; ;; - Added line as possible edges ; ;; - Added an error handler ; ;; - Added a timer to the search portion of the program ; ;; ; ;; The above changes amounted to an acceleration of about 4x from the ; ;; original program. ; ;; : ;; If you compile this program to a .fas you'll get more than 10x faster. ; ;; ; (defun c:A* ( / ssl ssp i edges startp endp openlst closelst found acdoc Edgelay Pathlay Pathcol Pathlwt) (vl-load-com) ; Changes values of following 4 global variables to suit your need. ; (setq Edgelay "Edges" Pathlay "Path" Pathcol 1 ; 1=Red 2=Yellow etc. ; Pathlwt 70 ; lineweight for path 0.7mm ; ) (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))) (set_errhandler '("CLAYER" "OSMODE" "CMDECHO")) (setvar 'CMDECHO 0) (setvar 'OSMODE 1) (if (setq ssp (ssget '"X" (list (cons 0 "LWPOLYLINE") (cons 8 Edgelay)))) (foreach en (mapcar (function cadr) (ssnamex ssp)) (setq edges (append edges (mk_edge (listpol2d en)))) ) ) (if (setq ssl (ssget '"X" (list (cons 0 "LINE") (cons 8 Edgelay)))) (foreach en (mapcar (function cadr) (ssnamex ssl)) (setq edges (cons (list (butlast (vlax-curve-getstartpoint en)) (butlast (vlax-curve-getendpoint en))) edges)) ) ) (setq startp (butlast (getpoint "\nPick Start Point: ")) ; Startpoint - reduced to 2D ; endp (butlast (getpoint "\nPick End Point: ")) ; Endpoint - reduced to 2D ; openlst (list (list startp '(0 0) 0.0 (distance startp endp))) ; Add starting node to openlst ; ) (vla-startundomark acdoc) (setq ti (getvar 'MILLISECS)) (while (and openlst (not found)) (setq node (car openlst)) (if (equal (car node) endp 1e-4) (setq found T closelst (cons node closelst)) (setq closelst (cons node closelst) openlst (upd_openlst edges node endp (cdr openlst) closelst) ) ) ) (if found (mk_lwp (get_path closelst)) (alert "No path was found") ) (princ (strcat "\nExecution time:" (itoa (- (getvar 'MILLISECS) ti)) " milliseconds.")) (*error* nil) ) ;; ; ;; upd_openlst ; ;; ; ;; Each node of the openlst is passed to this sub and we scan the edges list ; ;; to find the corresponding edges. Then both points of the edges are tested ; ;; for equality to the nodes. The fixed cost (distance) is updated and so is ; ;; the estimated total distance. Updates are first put in a temporary node. ; ;; ; ;; We then proceed to test if the temp variable is already in the closelst ; ;; and proceed to the next edge. ; ;; ; ;; If temp is true and temp is not in closelst we go to the recursive sub ; ;; in_openlst which adjust the values and return the updated openlst : ;; ; ;; Upon return we sort the openlst on smallest estimated distance ; ;; and return the openlst to the main routine ; ;; ; (defun upd_openlst (edges node endp openlst closelst / pt fcost p1 p2 d temp) (setq pt (car node) fcost (caddr node)) (while edges (setq p1 (caar edges) p2 (cadar edges) edges (cdr edges) d (distance p1 p2) temp nil) ;Testing both points of an edge and building a temporary node ; (cond ((equal pt p1 1e-4) (setq temp (list p2 p1 (+ fcost d) (+ fcost d (distance p2 endp))))) ((equal pt p2 1e-4) (setq temp (list p1 p2 (+ fcost d) (+ fcost d (distance p1 endp))))) ) (if (and temp (not (memberfuzz (car temp) closelst))) (setq openlst (in_openlst temp openlst)) ) ) ; Keep openlist sorted on smallest Estimated Total Cost ; (print (vl-sort openlst (function (lambda(a b)(< (cadddr a) (cadddr b))))) ) ) ;in_lst Replaced by memberfuzz ; ;(defun in_lst (pt lst) ; (cond ; ((not lst) nil) ; ((equal pt (caar lst) 1e-4) lst) ; (T (in_lst pt (cdr lst))) ; ) ;) ; returns a new openlst with a double exchanged if cost is lower ; ;; ; (defun in_openlst (node lst) (cond ((not lst) (list node)) ((equal (car node) (caar lst) 1e-4) (if (< (cadddr node) (cadddr (car lst))) (cons node (cdr lst)) lst ) ) (T (cons (car lst) (in_openlst node (cdr lst)))) ) ) (defun in_openlst2 (node lst / s c) (setq s (splitat (caar node) lst) c (cadddr node)) (cond ((not lst) (list node)) ((not (car s)) (cons node (cadr s))) ((not (cadr s)) (cons node (car s))) (T (if (< (cadddr node) (cadddr (cadr s))) (append (car s) (cons node (cdr s))) lst )) ;(T (c ns node lst)) ) ) ;; ; ;; listpol2D by ymg (Simplified a Routine by Gile Chanteau ; ;; ; ;; Parameter: en, Entity Name or Object Name of Any Type of Polyline ; ;; ; ;; Returns: List of Points in 2D WCS ; ;; ; ;; Notes: Requires butlast function for 2d points. ; ;; ; (defun listpol2d (en / i lst) (repeat (setq i (fix (1+ (vlax-curve-getEndParam en)))) (setq lst (cons (butlast (vlax-curve-getPointAtParam en (setq i (1- i)))) lst)) ) ) ;; ; ;; mk_edge ; ;; ; ;; From a list of consecutives points as supplied by listpol2D, ; ;; Returns a list of edges (((x1 y1)(x2 y2)) ((x2 y2)(x3 y3))...) ; ;; ; (defun mk_edge (lst) (mapcar (function (lambda (a b) (list a b ))) lst (cdr lst)) ) ;; ; ;; butlast ; ;; ; ;; Returns a list without the last item ; ;; Used here mainly to change points to 2D ; ;; ; (defun butlast (lst) (reverse (cdr (reverse lst)))) ;; ; ;; get_path ; ;; ; ;; Returns The list of points of shortest path found from closelst. ; ;; ; (defun get_path (lst / path) (setq path (list (caar lst)) prev (cadar lst) lst (cdr lst)) (while (setq lst (memberfuzz prev lst)) (setq prev (cadar lst) path (cons (caar lst) path) ) ) path ) ;; ; ;; memberfuzz by Gile Chanteau ; ;; ; ;; Modified to work with nodes list ; ;; ; (defun memberfuzz (p lst) (while (and lst (not (equal p (caar lst) 1e-4))) (setq lst (cdr lst)) ) lst ) (defun splitat (p lst / tr) (while (and lst (not (equal p (caar lst) 1e-4))) (setq tr (cons (car lst) tr) lst (cdr lst)) ) (list (reverse tr) lst) ) (defun truncfuzz (p lst) (if (and lst (not (equal p (caar lst) 1e-4))) (cons (car lst) (truncfuzz p (cdr lst))) ) ) (defun posfuzz (p lst) (- (length lst) (length (memberfuzz p lst))) ) (defun rotleft (lst) (append (cdr lst) (list (car lst)))) (defun rotright (lst) (cons (last lst) (butlast lst))) ;; ; ;; mk_lwp ; ;; ; ;; Draw an lwpolyline given a point list ; ;; ; ;; Will be drawn on layer with color and lineweight defined by Variables ; ;; at beginnung of program. ; ;; ; (defun mk_lwp (pl) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 Pathlay) (cons 62 Pathcol) (cons 90 (length pl)) (cons 70 0) (cons 370 Pathlwt) ) (mapcar (function (lambda (a) (cons 10 a))) pl) ) ) ) ;; Error Handler by Elpanov Evgenyi ; (defun set_errhandler (l) (setq varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) l)) ) (defun *error* (msg) (mapcar 'eval varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (vla-endundomark acdoc) (princ) ) (princ "A* to start") Astar rev3.lsp astar test.dwg

From what I inspected... That @dexus code works well with correct implementation of djikstra... When I used his code it bumped into endless (while) loop... Here is my revision and it should work, but result is not exact... Seems that resulting polyline is rummaging between references... Here is my revision : ; Attempt at drawing a centerline using voronoi diagram ; Voronoi diagram calculations found here: https://www.theswamp.org/index.php?topic=45085.msg503034#msg503034 (defun c:cl (/ _side ent->pts removeDuplicates minlen RemoveIDDup minpath1 triangulate getcircumcircle ss ent1 ent2 pl s1 s2 vor line) (defun _side (pline pnt / cpt end target der) (setq cpt (vlax-curve-getClosestPointTo pline pnt) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 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 (function -) (polar cpt (angle (list 0.0 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)) (list 0.0 0.0)) 1.0) ) (vlax-curve-getFirstDeriv pline target) ) ) (minusp (sin (- (angle cpt pnt) (angle (list 0.0 0.0) der)))) ) (defun _polyline (pts) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar (quote clayer))) (cons 70 0) ) (mapcar (function (lambda (x) (cons 10 x))) pts) ) ) ) (defun ent->pts (ent acc / end ind step rtn) (setq end (vlax-curve-getEndParam ent)) (setq ind (vlax-curve-getStartParam ent)) (setq step (/ end (float acc))) (while (< ind end) (setq rtn (cons (vlax-curve-getPointAtParam ent ind) rtn)) (setq ind (+ ind step)) ) rtn ) (defun removeDuplicates (lst / a ll) (while (setq a (car lst)) (if (vl-some (function (lambda (x) (equal x a 1e-6))) (cdr lst)) (setq ll (cons a ll) lst (vl-remove-if (function (lambda (x) (equal x a 1e-6))) (cdr lst))) (setq ll (cons a ll) lst (cdr lst)) ) ) (reverse ll) ) ; https://www.theswamp.org/index.php?topic=45092.msg578984#msg578984 (defun minlen (LtsLine startEnd / ID1 ID2 IDEnd IDStart LtsID LtsIDFil LtsIDPnt LtsID_Edge LtsPath P1 P2 listpoint) (setq LtsPnt (removeDuplicates (apply (function append) LtsLine))) (setq LtsIDPnt (mapcar (function (lambda (x) (list (vl-position x LtsPnt) x))) LtsPnt)) (setq LtsID (mapcar (function (lambda (x) (vl-position x LtsPnt))) LtsPnt)) (setq IDStart (vl-position (caar startEnd) LtsPnt)) (setq IDEnd (vl-position (caadr startEnd) LtsPnt)) (setq LtsID_Edge (list)) (foreach e LtsLine (setq ID1 (caar (vl-remove-if-not (function (lambda (x) (equal (car e) (cadr x) 1e-6))) LtsIDPnt))) (setq ID2 (caar (vl-remove-if-not (function (lambda (x) (equal (cadr e) (cadr x) 1e-6))) LtsIDPnt))) (setq LtsID_Edge (append LtsID_Edge (list (list ID1 ID2 (distance (nth ID1 LtsPnt) (nth ID2 LtsPnt)))))) ) (setq LtsIDFil (RemoveIDDup LtsID_Edge)) (setq LtsPath (minpath1 IDStart IDEnd LtsID LtsIDFil)) (setq listpoint (mapcar (function (lambda (x) (nth (car x) LtsPnt))) LtsPath)) ) (defun RemoveIDDup (l) (if l (cons (car l) (RemoveIDDup (vl-remove-if (function (lambda (x) (or (and (= (car x) (car (car l))) (= (cadr x) (cadr (car l))) ) (and (= (car x) (cadr (car l))) (= (cadr x) (car (car l))) ) ) )) (cdr l) ) ) ) ) ) (defun minpath1 (g f nodes edges / brname clnodes closedl go new nodname old openl totdist ppath) (setq nodes (vl-remove g nodes)) (setq openl (list (list g 0 nil))) (setq closedl nil) (setq go t) (foreach n nodes (setq nodes (subst (list n 0 nil) n nodes)) ) (while (and go (not (= (caar closedl) f))) (setq nodname (caar openl)) (setq totdist (cadar openl)) (setq closedl (cons (car openl) closedl)) (setq openl (cdr openl)) (setq clnodes (mapcar (function car) closedl)) (foreach e edges (setq brname nil) (cond ( (= (car e) nodname) (setq brname (cadr e)) ) ( (= (cadr e) nodname) (setq brname (car e)) ) ) (if brname (progn (setq new (list brname (+ (caddr e) totdist) nodname)) (cond ( (member brname clnodes) ) ( (setq old (vl-some (function (lambda (x) (if (= brname (car x)) x))) openl)) (if (< (cadr new) (cadr old)) (setq openl (subst new old openl)) ) ) ( t (setq openl (cons new openl)) ) ) ) ) ) (setq openl (vl-sort openl (function (lambda (a b) (< (cadr a) (cadr b)))))) (and (null openl) (null (caar closedl)) (setq go nil)) ) (setq ppath (list (car closedl))) (foreach n closedl (if (= (car n) (caddr (car ppath))) (setq ppath (cons n ppath)) ) ) ppath ) ;;***************************************************************************; ;; Triangulate ; ;; Structure of Program by ElpanovEvgeniy ; ;; 17.10.2008 ; ;; edit 20.05.2011 ; ;; Program triangulate an irregular set of 3d points. ; ;; Modified and Commented by ymg June 2011. ; ;; Modified to operate on index by ymg in June 2013. ; ;; Contour Generation added by ymg in July 2013. ; ;; Removed lots of code not used for centerline function November 2025. ; ;;***************************************************************************; (defun triangulate (pl / a al b bb c cp ctr e el epos l n np npos pt r sl tl tr vl vor xmax xmin ymax ymin) (if pl (progn (setq tl nil pl (vl-sort pl (function (lambda (a b) (< (car a) (car b))))) ; Sort points list on x coordinates bb (list (apply 'mapcar (cons 'min pl)) (apply 'mapcar (cons 'max pl))) ; Replaced code to get the min and max with 3d Bounding Box Routine ; A bit slower but clearer. zmin and zmax kept for contouring xmin (caar bb) xmax (caadr bb) ymin (cadar bb) ymax (cadadr bb) np (length pl) ; Number of points to insert cp (list (/ (+ xmin xmax) 2.0) (/ (+ ymin ymax) 2.0)) ; Midpoint of points cloud and center point of circumcircle through supertriangle. r (* (distance cp (list xmin ymin)) 20) ; This could still be too small in certain case. No harm if we make it bigger. sl (list (list (+ (car cp) r) (cadr cp) 0) (list (- (car cp) r) (+ (cadr cp) r) 0) (list (- (car cp) r) (- (cadr cp) r) 0) ) ; sl list of 3 points defining the Supertriangle, I have tried initializing to an infinite triangle but it slows down calculation pl (append pl sl) ; Vertex of Supertriangle are appended to the Point list sl (list np (+ np 1) (+ np 2)) ; sl now is a list of index into point list defining the supertriangle al (list (list xmax cp r sl)) ; Initialize the Active Triangle list ; al is a list that contains active triangles defined by 4 items: ; item 0: Xmax of points in triangle. ; item 1: List 2d coordinates of center of circle circumscribing triangle. ; item 2: Radius of above circle. ; item 3: List of 3 indexes to vertices defining the triangle ctr (list cp) ; added for Voronoi n -1 ; n is a counting index into Point List ) ; Begin insertion of points (repeat np (setq n (1+ n) ; Increment Index into Point List pt (nth n pl) ; Get one point from point list el nil) ; el list of triangles edges (repeat (length al) ; Loop to go through Active triangle list (setq tr (car al) ; Get one triangle from active triangle list. al (cdr al)) ; Remove the triangle from the active list. (cond ( (< (car tr) (car pt)) (setq tl (cons (cadddr tr) tl) ctr (cons (cadr tr) ctr)) ; added for voronoi ) ; This triangle inactive. We store it's 3 vertex in tl (Final triangle list). ( (< (distance pt (cadr tr)) (caddr tr)) ; pt is inside the triangle. (setq tr (cadddr tr) ; Trim tr to vertex of triangle only. a (car tr) ; Index of First point. b (cadr tr) ; Index of Second point. c (caddr tr)) ; Index of Third point. (setq el (vl-list* (list a b) (list b c) (list c a) el)) ; ((a b) (b c) (c a) (. .) (. .).....) ) ( t (setq l (cons tr l)) ) ; tr did not meet any cond so it remain active. We store it in the swap list ) ; End cond ) ; End repeat (length al) (setq al l ; Restore active triangle list from the temporary list. l nil) ; Clear the swap list to prepare for next insertion. ; Removes doubled edges, calculates circumcircles and add them to al (while el (if (or (member (reverse (car el)) el) (member (car el) (cdr el)) ) (setq el (vl-remove (reverse (car el)) el) el (vl-remove (car el) el)) (setq al (cons (getcircumcircle n (car el) pl) al) el (cdr el)) ) ) ) ; End repeat np ; We are done with points insertion. Any triangle left in al is added to tl (foreach tr al (setq tl (cons (cadddr tr) tl) ctr (cons (cadr tr) ctr)) ; Added for Voronoi ) ; Extract all triangle edges from tl and form edges list el (setq el nil) (foreach tr tl (setq el (vl-list* (list (caddr tr) (car tr)) (list (cadr tr) (caddr tr)) (list (car tr) (cadr tr)) el ) ) ) (setq el (reverse el)) ; Here let's draw the Voronoi Diagram (setq vl nil) (foreach e el (setq npos (vl-position (reverse e) el) epos (vl-position e el)) (if npos (setq vl (cons (list (/ npos 3) (/ epos 3)) vl)) (setq vl (cons (list (- (length ctr) 1) (/ epos 3)) vl)) ) ) (setq vor nil) (while vl (setq e (car vl) vl (vl-remove (reverse e) (cdr vl)) vor (cons e vor)) ) (mapcar (function (lambda (v) (list (nth (cadr v) ctr) (nth (car v) ctr) ) )) (cdddr ; Remove the edges of Supercircle (vl-sort vor (function (lambda (a b) (> (car a) (car b)) )) ) ) ) ) ) ) ;;************************************************************************************************; ;; Written by ElpanovEvgeniy ; ;; 17.10.2008 ; ;; Calculation of the centre of a circle and circle radius ; ;; for program triangulate ; ;; ; ;; Modified ymg june 2011 (renamed variables) ; ;; Modified ymg June 2013 to operate on Index ; ;;************************************************************************************************; (defun getcircumcircle (a el pl / b c c2 cp r ang vl pt) (setq pt (nth a pl) b (nth(car el) pl) c (nth(cadr el) pl) c2 (list (car c) (cadr c)) ; c2 is point c but in 2d vl (list a (car el) (cadr el))) (if (not (zerop (setq ang (- (angle b c) (angle b pt))))) (progn (setq cp (polar c2 (+ -1.570796326794896 (angle c pt) ang) (setq r (/ (distance pt c2) (sin ang) 2.0))) r (abs r)) (list (+ (car cp) r) cp r vl) ) ) ) (if (not (while (cond ( (not (setq ss (ssget (list (cons 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 pl (append (ent->pts ent1 100) (ent->pts ent2 100))) (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 vor (triangulate pl)) (setq vor (vl-remove-if-not (function (lambda (line) (and (equal s1 (_side ent1 (car line))) (equal s1 (_side ent1 (cadr line))) (equal s2 (_side ent2 (car line))) (equal s2 (_side ent2 (cadr line))) ) )) (vl-remove-if (function (lambda (x) (or (equal x (list nil nil)) (not (car x)) (not (cadr x))))) vor) ) ) (if (< (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent2)) (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) ) (setq start (list (vlax-curve-getEndPoint ent1) (vlax-curve-getStartPoint ent1)) end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2))) (setq start (list (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1)) end (list (vlax-curve-getStartPoint ent2) (vlax-curve-getEndPoint ent2))) ) (setq startEnd (mapcar (function (lambda (end1 end2) (caar (vl-sort (mapcar (function (lambda (line) (list line (+ (distance (car line) end1) (distance (car line) end2) (distance (cadr line) end1) (distance (cadr line) end2) ) ) )) vor ) (function (lambda (a b) (< (cadr a) (cadr b)) )) ) ) )) start end ) ) (_polyline ( (lambda (lst / rtn) ; Draw a line of the midpoints of voronoi lines (while (cdr lst) (setq rtn (cons (mapcar (function (lambda (a b) (* (+ a b) 0.5))) (car lst) (cadr lst) ) rtn ) ) (setq lst (cdr lst)) ) rtn ) (minlen vor startEnd) ) ) ) ) (princ) )

Another for fun - should work in all UCS/Views: (defun c:itsatrap ( / hgt len ocs off pt1 pt2 ) (if (and (setq pt1 (getpoint "\nInsertion point: ")) (setq len (getdist "\nLength of base: " pt1)) (setq hgt (getdist "\nHeight: " pt1)) (setq ocs (trans '(0 0 1) 1 0 t) pt2 (cons (+ (car pt1) len) (cdr pt1)) off (* hgt (/ (sqrt 3) 3)) ) ) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 (trans pt1 1 ocs)) (cons 10 (trans pt2 1 ocs)) (cons 10 (trans (list (+ (car pt2) off) (+ (cadr pt2) hgt) (caddr pt2)) 1 ocs)) (cons 10 (trans (list (- (car pt1) off) (+ (cadr pt1) hgt) (caddr pt1)) 1 ocs)) (cons 210 ocs) ) ) ) (princ) )

Using a voronoi diagram (code by ymg, ElpanovEvgeniy and Marko Ribar) You can get some very good reference points. Just have to find a way to get rid of all the 'branches' and then take al the midpoints of every line to get a good centerline. centerline-voronoi.lsp

I don't believe I posted my Import multiple PDF pages as AutoCAD objects LISP. It does most of what I need, so I doubt if I'll spend any more time on it. ;;; Imports indicated page(s), converts to DWG entities, then arranges them spaced along +X. | ;;;-----------------------------------------------------------------------------------------------| ;;; ImPDF.lsp | ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; Requires: AutoCAD 2024 + | ;;;-----------------------------------------------------------------------------------------------| (defun c:ImPDF (/ pdfPath pgStart pgEnd pg insPt gap doc ms layerColor bgColor layerName blk ) (vl-load-com) ;; Detect background color (setq bgColor (getvar "BACKGROUNDCOLOR")) ; 0=black, 7=white (setq layerColor (if (= bgColor 0) 7 0 ) ) ; white on black, black on white ;; Select PDF file (setq pdfPath (getfiled "Select PDF file to import" "" "pdf" 8)) (if (not pdfPath) (exit) ) ;; Page range (setq pgStart (getint "\nStart page <1>: ")) (if (not pgStart) (setq pgStart 1) ) (setq pgEnd (getint "\nEnd page <same>: ")) (if (not pgEnd) (setq pgEnd pgStart) ) ;; Starting insertion point (setq insPt (getpoint "\nInsertion point: ")) (if (not insPt) (setq insPt '(0 0 0)) ) ;; Gap between pages (setq gap (getreal "\nGap between pages <5.0>: ")) (if (not gap) (setq gap 5.0) ) ;; Get AutoCAD document (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) ;; Set all entities inside block definition to layer + color (defun set-block-contents-color (blkRef layer color / blkDef) (setq blkDef (vla-item (vla-get-Blocks doc) (vla-get-Name blkRef))) (vlax-for ent blkDef (vl-catch-all-apply 'vla-put-layer (list ent layer)) (vl-catch-all-apply 'vla-put-color (list ent color)) ) ) ;; Loop through pages (setq pg pgStart) (while (<= pg pgEnd) (princ (strcat "\nImporting page " (itoa pg) "...")) ;; Attach PDF underlay (command "_-PDFATTACH" pdfPath (itoa pg) insPt 1.0 0.0) (setq u (entlast)) ;; underlay reference ;; Import to geometry (All, then detach) (command "_PDFIMPORT" u "All" "D") ;; The imported block reference is the last entity (setq blk (entlast)) (if blk (progn ;; Create layer for this page (setq layerName (strcat "PDF_Page_" (itoa pg))) (if (not (tblsearch "layer" layerName)) (vl-catch-all-apply 'vla-Add (list (vla-get-Layers doc) layerName) ) ) ;; Move block reference to layer (vl-catch-all-apply 'vla-put-layer (list (vlax-ename->vla-object blk) layerName) ) ;; Set nested geometry inside block (set-block-contents-color (vlax-ename->vla-object blk) layerName layerColor ) ;; Compute block width for next insertion point (setq minX 1e20 maxX -1e20 ) (vl-catch-all-apply 'vla-getboundingbox (list (vlax-ename->vla-object blk) 'pmin 'pmax) ) (setq pmin (vlax-safearray->list pmin)) (setq pmax (vlax-safearray->list pmax)) (setq width (- (car pmax) (car pmin))) (if (<= width 0.0) (setq width 100.0) ) ;; Update insertion point for next page (setq insPt (list (+ (car insPt) width gap) (cadr insPt) 0)) ) ) ;; Next page (setq pg (1+ pg)) ) (command "_ZOOM" "_E") (princ "\nAll pages imported successfully." ) (princ) ) With RLX's revision. ;;; Imports indicated page(s), converts to DWG entities, then arranges them spaced along +X. | ;;;-----------------------------------------------------------------------------------------------| ;;; ImPDF_0.2-RLX.lsp | ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; Requires: AutoCAD 2017 + (for PDFIMPORT) | ;;; ;;; Revision by RLX ;;; ;;;-----------------------------------------------------------------------------------------------| (defun c:ImPDF (/ pdfPath pgStart pgEnd pg insPt gap doc ms layerColor bgColor layerName blk ) (vl-load-com) ;; Detect background color (setq bgColor (getvar "BACKGROUNDCOLOR")) ; 0=black, 7=white (setq layerColor (if (= bgColor 0) 7 0 ) ) ; white on black, black on white ;; Select PDF file (setq pdfPath (getfiled "Select PDF file to import" "" "pdf" 8)) (if (not pdfPath) (exit) ) ;; Page range (setq pgStart (getint "\nStart page <1>: ")) (if (not pgStart) (setq pgStart 1) ) (setq pgEnd (getint "\nEnd page <same>: ")) (if (not pgEnd) (setq pgEnd pgStart) ) ;; Starting insertion point (setq insPt (getpoint "\nInsertion point: ")) (if (not insPt) (setq insPt '(0 0 0)) ) ;; Gap between pages (setq gap (getreal "\nGap between pages <5.0>: ")) (if (not gap) (setq gap 5.0) ) ;; Get AutoCAD document (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) ;; Set all entities inside block definition to layer + color (defun set-block-contents-color (blkRef layer color / blkDef) (if (and blkRef (vlax-method-applicable-p blkRef 'Name)) (progn (setq blkDef (vla-item (vla-get-Blocks doc) (vla-get-Name blkRef))) (vlax-for ent blkDef (vl-catch-all-apply 'vla-put-layer (list ent layer)) (vl-catch-all-apply 'vla-put-color (list ent color)) ) ) ) ) ;; Loop through pages (setq pg pgStart) (while (<= pg pgEnd) (princ (strcat "\nImporting page " (itoa pg) "...")) ;; Attach PDF underlay (command "_-PDFATTACH" pdfPath (itoa pg) insPt 1.0 0.0) (setq u (entlast)) ;; underlay reference ;; Import to geometry (All, then detach) (command "_PDFIMPORT" u "All" "D") ;; The imported block reference is the last entity (setq blk (entlast)) (if blk (progn ;; Create layer for this page (setq layerName (strcat "PDF_Page_" (itoa pg))) (if (not (tblsearch "layer" layerName)) (vl-catch-all-apply 'vla-Add (list (vla-get-Layers doc) layerName) ) ) ;; Move block reference to layer (vl-catch-all-apply 'vla-put-layer (list (vlax-ename->vla-object blk) layerName) ) ;; Set nested geometry inside block (set-block-contents-color (vlax-ename->vla-object blk) layerName layerColor ) ;; Compute block width for next insertion point (setq minX 1e20 maxX -1e20 ) (vl-catch-all-apply 'vla-getboundingbox (list (vlax-ename->vla-object blk) 'pmin 'pmax) ) (setq pmin (vlax-safearray->list pmin)) (setq pmax (vlax-safearray->list pmax)) (setq width (- (car pmax) (car pmin))) (if (<= width 0.0) (setq width 100.0) ) ;; Update insertion point for next page (setq insPt (list (+ (car insPt) width gap) (cadr insPt) 0)) ) ) ;; Next page (setq pg (1+ pg)) ) (command "_ZOOM" "_E") (princ "\nAll pages imported successfully." ) (princ) )

I did some more tests today and found that when the end segments were parallel, they didn't get added to the line. So I added support for that. This one was easy because the _cornerOffset function already checks for parallel segments and I just had to add a flag to inform the offset loop. And I found another example which it has a hard time on with concentric arcs, attached below. But that will be for another day since I have no more time for that this week. AxisExple3.dxf

(ssget "_X" (list (cons 0 "~3DSOLID")))

Nice test @PGia, thanks! For some reason I didnt consider closed polylines in the _checkOffset function, so I added an extra check there. Should work as expected now: Not sure about the short corner. The lines are so narrow the centerline is pushed back out of the point. Seems to be logical to me but it does feel intuitive. Narrow indents don't get much love from the centerline. So "inlets" don't have enough influence on the shape of the line. What would the expected result be? Below makes sense since there is not enough space to go into the indent. Or are you maybe something like this where the line splits and goes into the hole:

Or just call MULTIPLE before calling APV.

Another way. this doesn't repeat but uses ldata so the user can just hit enter if they aren't changing the offset from last value inputted. Has to have an existing polyline to run and the new end point. will only update the last two closest points of the old polyline to the new end point. Route.mp4 Route.lsp

This is a very simple test to make everything is inside the code including the images. next step would be to look at the Lee-mac example and use vectors rather than slides. Thanks to RLX for convert DCL. ; https://www.cadtutor.net/forum/topic/98827-the-coordinates-of-the-trapezoid/page/2/#comment-677242 ; Fill in 4 image dcl with vector images ; simple working example by AlanH Nov 2025 (setq imgslst (list (list (list 19 222 128 222 7) (list 128 222 128 114 7) (list 128 114 19 114 7) (list 19 114 19 222 7)) (list (list 37 202 119 202 7) (list 119 202 139 120 7) (list 139 120 17 120 7) (list 17 120 37 202 7)) (list (list 36 203 120 203 7) (list 120 203 101 161 7) (list 141 119 16 119 7) (list 16 119 36 203 7)(list 101 161 141 119 7)) (list (list 38 200 118 200 7) (list 118 200 99 160 7) (list 138 120 18 120 7) (list 55 168 38 200 7)(list 99 160 138 120 7)(list 55 168 18 120 7)) ) ) (defun VECTOR4 (dclkey imglst / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -2) (foreach x imglst (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x)) ) (end_image) (princ) ) (defun makedcl ( / ) (setq dcl (vl-filename-mktemp nil nil ".dcl") ) (setq des (open dcl "w") ) (foreach x '( "// dd2x2 dialogue. Used by the d2x2 command in dd2x2.lsp." "// Called from the AutoCAD Release 12 Standard Menu." "dd2x2: dialog {" " label = \"Pick shape\";" " : column {" " : row {" " : image_button {" " key = \"22sq1\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " : image_button {" " key = \"22sq2\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " }" " : row {" " : image_button {" " key = \"22sq3\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " : image_button {" " key = \"22sq4\";" " width = 15;" " aspect_ratio = 1.0;" " color = 0;" " allow_accept = true;" " }" " }" " }" "ok_cancel;" "}" ) (write-line x des ) ); foreach (close des) (princ) ) (defun wow ( / x ans dcl keynum imgsitem dclkey ) (makedcl) (setq dcl_id (load_dialog dcl)) (if (not (new_dialog "dd2x2" dcl_id) ) (exit) ) (setq keynum 1) (repeat 4 (setq imgsitem (nth (- keynum 1) imgslst)) (setq dclkey (strcat "22sq" (rtos keynum 2 0))) (VECTOR4 dclkey imgsitem) (setq keynum (1+ keynum)) ) (action_tile "22sq1" "(setq ans $key)(done_dialog)") (action_tile "22sq2" "(setq ans $key)(done_dialog)") (action_tile "22sq3" "(setq ans $key)(done_dialog)") (action_tile "22sq4" "(setq ans $key)(done_dialog)") (action_tile "accept" "(setq ans $key)(done_dialog)") (action_tile "cancel" "(setq ans $key)(done_dialog)") (start_dialog) (unload_dialog dcl_id) (vl-file-delete dcl) (princ (strcat "\nsq picked = " ans)) (princ) ) (wow)

I made some simple shapes and used Vectorize to do just that, here are some samples. next step is to look at Lee-Mac example. Only read the vectors pattern in the following code. ;******************************************************************************** ; Function to draw a vector image within a dialogue Image tile or Image Button. * ; Argument: 'DCLKEY' - the dcl key of the image tile/button to be filled. * ; Do NOT edit the dcl dimension text below, this is needed by Vectorize. * ;******************************************************************************** ; Compiled for dcl dimensions of width,24.92, height,24.97, * ;******************************************************************************** (defun VECTOR1 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((19 222 128 222 7) (128 222 128 114 7) (128 114 19 114 7) (19 114 19 222 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (defun VECTOR2 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((37 202 119 202 7) (119 202 139 120 7) (139 120 17 120 7) (17 120 37 202 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (defun VECTOR3 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((36 203 120 203 7) (120 203 101 161 7) (141 119 16 119 7) (16 119 36 203 7) (101 161 141 119 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (defun VECTOR4 (DCLKEY / i j) (setq i (/ (dimx_tile DCLKEY) 151.) j (/ (dimy_tile DCLKEY) 326.)) (start_image DCLKEY) (fill_image 0 0 (dimx_tile DCLKEY)(dimy_tile DCLKEY) -15) (foreach x '((38 200 118 200 7) (118 200 99 160 7) (138 120 18 120 7) (55 168 38 200 7) (99 160 138 120 7) (55 168 18 120 7)) (vector_image (fix (* (car x) i))(fix (* (cadr x) j))(fix (* (caddr x) i))(fix (* (cadddr x) j))(last x))) (end_image) (princ) ) (setq imgslst (list (list (list 19 222 128 222 7) (list 128 222 128 114 7) (list 128 114 19 114 7) (list 19 114 19 222 7)) (list (list 37 202 119 202 7) (list 119 202 139 120 7) (list 139 120 17 120 7) (list 17 120 37 202 7)) (list (list 36 203 120 203 7) (list 120 203 101 161 7) (list 141 119 16 119 7) (list 16 119 36 203 7)(list 101 161 141 119 7)) (list (list 38 200 118 200 7) (list 118 200 99 160 7) (list 138 120 18 120 7) (list 55 168 38 200 7)(list 99 160 138 120 7)(list 55 168 18 120 7)) ) ) Watch this psace. VECTORIZE.lsp

I always try to avoid using command when I can. entmakex is faster and doesn't output to the command line. wrapping with setq you can even save the entity or add to selection set. (setq pts (list p1 p2 p3 p4)) (setq trap (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) ) (sssetfirst nil (ssadd trap))

Everything SLW210 has researched is very interesting. I had no idea this had been such a thoroughly discussed topic — and with such limited success. I guess that makes it even more interesting. In my opinion, it is possible to obtain a center polyline that is equidistant from both edges. But two conditions must be met: 1. The user must ensure that the geometry of both edges is correct: they must be 2D polylines with no repeated points and no geometric inconsistencies of any kind. And, in principle, to avoid extending the search for a solution, these polylines should not contain arcs. 2. One must accept that any edge containing “recesses” (“recodos”) must be handled using auxiliary axes. What is a recess? It is a geometric setback, in any direction, along one of the edges. For example: if you advance segment by segment along an edge (in either direction), the start of a recess would be defined as any vertex from which the shortest distance to the opposite edge forces the projection to intersect its own edge. My conclusion: for edges without recesses, I believe it is possible to find an equidistant centerline or axis. And for edges with recesses, although considerably more code will be needed, they should be solvable using auxiliary axes. I hope to have code soon that supports all of this.

Obviously we don't have your batch LISP - I guess your company paid for this and so you are not going to be popular sharing that for all online. LISPs can be added to scripts - both as a command and as code. There are others out there such as ScriptPro and Lee Macs Script Writer which will do this. BigAl will often post snippets of scripts here to batch process files - last one he did was in the last week or so ago. You could even set this up as a stand alone script to do just the one task (see BigAls last example....) The first step for all is to get a LISP working as you want and well on a single file and then to do it as a batch (first time running the batch with a new LISP, perhaps check carefully that it doesn't do anything unexpected on other files). Plenty of examples out there to change layer names from one to another - have a look to see if you see one you like to use, or if there isn't am sure we can put one together - and use what is above as a started if you want to have a go, I think all the code you need is in the examples, just need to think how to change them to your needs

Hi everyone, I’ve been working on a small production tool in AutoLISP/VLISP for AutoCAD / Civil 3D and thought it might be useful to share here for anyone doing a lot of section or profile sheets. ## What problem it solves On corridor / section jobs we often end up with several paper-space viewports that all need to: - Use the same scale and twist - Stay aligned to a centerline / path (alignment, guide polyline, etc.) - Be re-centered after design changes The usual manual workflow for us was: 1. Set up one “master” viewport with the correct scale, twist, layers, etc. 2. Copy that viewport across the layout for each station/section. 3. Manually PAN/ZOOM/DVIEW in each viewport to center the correct station along the path. 4. Repeat that pan/zoom step any time the design or alignment changed. It works, but it’s tedious and easy to make mistakes when you have a lot of sheets. ## What SectionSync LITE does SectionSync LITE is a compiled VLX that: - Lets you pick a polyline path (e.g. alignment, section chain, etc.) - Associates multiple paper-space viewports with positions along that path - Updates the view center of each viewport so it “follows” the path - Preserves the existing viewport scale and twist - Can be re-run after design changes so you don’t have to manually re-pan everything It was written mainly with Civil 3D section/profile sheets in mind, but it’s just working with standard AutoCAD viewports and a polyline. ## Technical notes - Written in AutoLISP/Visual LISP and compiled to VLX for distribution. - Uses vla/vlax functions to read and set viewport center, width/height, and twist. - Path positions are based on cumulative distance along the selected polyline. - No reactors or custom objects – it just runs on demand and updates existing VPs. ## Demo + download Short demo video: https://youtu.be/l1JRbz4_owQ Download / more details (there’s a built-in 5-run / 7-day trial so you can test it on a real project): https://autolispwizard.gumroad.com/l/civabs If anyone is interested in the implementation details (polyline parameterization, handling UCS and VP twist, etc.) I’m happy to discuss approaches or share pseudo-code for the core parts.

Great! Thanx! It did gave me an error after the first page so I changed one of your subs a little. added this line : (and blkRef (vlax-method-applicable-p blkRef 'Name)) (defun set-block-contents-color (blkRef layer color / blkDef) (if (and blkRef (vlax-method-applicable-p blkRef 'Name)) (progn (setq blkDef (vla-item (vla-get-Blocks doc) (vla-get-Name blkRef))) (vlax-for ent blkDef (vl-catch-all-apply 'vla-put-layer (list ent layer)) (vl-catch-all-apply 'vla-put-color (list ent color)) ) ) ) )

With (initget) and (getkword) for choice precision... (vl-load-com) (defun c:change_prec ( / ss AcDoc Space prec_source ktarget n ename Obj value_string nbs tmp_nbs) (princ "\nSelect MText.") (while (null (setq ss (ssget (list '(0 . "*TEXT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nAren't MText or Text!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (initget 1 "0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Current") (setq ktarget (getkword "\nPrecision of target number [0/1/2/3/4/5/6/7/8/9/10/11/12/13/14/15/16/Current]?: ")) (repeat (setq n (sslength ss)) (setq ename (ssname ss (setq n (1- n))) Obj (vlax-ename->vla-object ename) ) (setq value_string (vla-FieldCode Obj) nbs 0) (cond ((vl-string-search "%<\\" value_string nbs) (while nbs (if (setq nbs (vl-string-search "%pr" value_string (setq tmp_nbs nbs))) (setq prec_source (itoa (atoi (substr value_string (+ nbs 4) 2))) value_string (vl-string-subst (if (eq ktarget "Current") (strcat "%pr" (itoa (getvar "LUPREC"))) (strcat "%pr" ktarget) ) (strcat "%pr" prec_source) value_string tmp_nbs ) nbs (1+ nbs) ) ) ) (vlax-put Obj 'TextString value_string) ) ) ) (vla-endundomark AcDoc) (prin1) )

I'll have to debug it when i get home just typed it up in note pad. -Edit Well if i took two seconds to look at the code. was using integers and needs to be strings. because Tusky is calling vl-string-subst. if its still bugged ill fix it tonight.

You're welcome @Clint . Yes, the DCL file are not necessary every time, but it can be helpful and user-friendly to accomplish desired result (like this one from an example video from above) if you have multiple choosing (for eg. buttons or check-boxes for Uppercase, Lowercase, Renaming, etc.). Best regards.

You can try this. (vl-load-com) (defun c:change_prec ( / ss AcDoc Space n ename Obj value_string nbs tmp_nbs) (princ "\nSelect MText.") (while (null (setq ss (ssget (list '(0 . "*TEXT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nAren't MText or Text!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (repeat (setq n (sslength ss)) (setq ename (ssname ss (setq n (1- n))) Obj (vlax-ename->vla-object ename) ) (setq value_string (vla-FieldCode Obj) nbs 0) (cond ((eq (substr (vla-FieldCode Obj) 1 3) "%<\\") (while nbs (if (setq nbs (vl-string-search "%pr2" value_string (setq tmp_nbs nbs))) (setq value_string (vl-string-subst "%pr1" "%pr2" value_string tmp_nbs) nbs (1+ nbs) ) ) ) (vlax-put Obj 'TextString value_string) ) ) ) (vla-endundomark AcDoc) (prin1) )

Maybe this kind of solution can be interesting (to use a multiple selection, use Shift+Left mouse click, to use a single selection, use CTRL+Left mouse click): ; ************************************************************************** ; Functions : CHRENLAYERS ; Description : Select Layers To Change It To UPPERCASE Or LOWERCASE ; Author : SAXLLE ; Date : December 04, 2025 ; ************************************************************************** (prompt "\nSelect Layers To Change It To UPPERCASE Or LOWERCASE!\nTo run a LISP type: CHRENLAYERS") (princ) (defun c:CHRENLAYERS ( / old_echo dcl_id fname fn laylist lay items rval acad name) (vl-load-com) (setq old_echo (getvar 'cmdecho)) (setvar 'cmdecho 0) (create_dialog) (collect_layers) (setq dcl_id (load_dialog fname)) (if (not (new_dialog "Laylist" dcl_id)) (exit) ) (action_tile "cancel" "(cancel)") (start_list "ls") (mapcar 'add_list laylist) (end_list) (action_tile "ps1" "(read_items) (to_uppercase)") (action_tile "ps2" "(read_items) (to_lowercase)") (start_dialog) (unload_dialog dcl_id) (vl-file-delete fname) (gc) (princ) ) (defun cancel () (done_dialog 0) (terpri) (prompt "Application running were finished...") (princ) ) (defun collect_layers () (setq laylist (list) lay (tblnext "LAYER" T) ) (while lay (if (not (equal (cdr (assoc 2 lay)) "0")) (setq laylist (cons (cdr (assoc 2 lay)) laylist) lay (tblnext "LAYER") ) (setq lay (tblnext "LAYER")) ) ) (setq laylist (vl-sort laylist '<)) ) (defun read_items () (setq acad (vla-get-activedocument (vlax-get-acad-object))) (setq items (get_tile "ls") rval (mapcar '(lambda (x) (nth x laylist)) (read (strcat "(" items ")"))) ) ) (defun to_uppercase () (foreach item rval (setq name (strcase item)) (vla-SendCommand acad (strcat "-RENAME LA " item (chr 13) name (chr 13))) (prompt (strcat "\nThe layer " item " were changed into the UPPERCASE!")) (setvar 'cmdecho old_echo) (princ) ) (done_dialog 1) ) (defun to_lowercase () (foreach item rval (setq name (strcase item T)) (vla-SendCommand acad (strcat "-RENAME LA " item (chr 13) name (chr 13))) (prompt (strcat "\nThe layer " item " were changed into the LOWERCASE!")) (setvar 'cmdecho old_echo) (princ) ) (done_dialog 1) ) (defun create_dialog () (setq fname (vl-filename-mktemp "Laylist.dcl") fn (open fname "w") ) (write-line "Laylist :dialog { label = \"Select layers to change it to UPPERCASE or LOWERCASE!\"; :list_box { key = \"ls\"; multiple_select = true; height = 10; width = 50; } :row { :button { label = \"Change to UPPERCASE >>\"; key = \"ps1\"; fixed_width = true; } :button { label = \"Change to LOWERCASE >>\"; key = \"ps2\"; fixed_width = true; } :button { label = \"Cancel\"; key = \"cancel\"; mnemonic = \"C\"; alignment = centered; fixed_width = true; is_cancel=true; } } }" fn) (close fn) ) Also, you can see the short video example of how it works. CHRENLAYERS.mp4 Best regards.

It could be as simple as changing "all" to "ss", where ss is a selection set. I am no expert on setting the exclude objects in a selection set. try this not really tested. (setq ss (ssget "_X" '((-4 . "<NOT") (0 . "3DSOLID") (-4 . "NOT>")))) or _move;(setq ss (ssget "_X" '((-4 . "<NOT") (0 . "3DSOLID") (-4 . "NOT>"))));;0,0,0;0,0,1e99;_move;ss;;0,0,0;0,0,-1e99

You could try the search function... maybe this thread from lasty week might help?

Have a look at (setq lays (layoutlist)) there is no Model in the list created saves a few if and buts. Can use also (setvar 'ctab "Model") so no Doc required.

I’ve always thought that a centerline should keep the same distance to the left and right, in the direction of travel. But from a geometric standpoint, maybe it should be as you say.I won’t get into that controversy. Perhaps that approach does make it possible to obtain the centerline in more situations. Regarding @SLW210’s suggestion that I upload a drawing to put the proposed Lisp codes to the test, I think the most appropriate example is the bank of a small river. I trimmed a section and ran the codes by @dexus, @Lee Mac, @SLW210, @mhupp, and @GP_ on it. The geometry of the riverbanks seems to be quite stressful for all the codes, although Dexus’s code only loses control in a couple of areas. I’m attaching the file with all of this for anyone who wants to take a look. AxisExple2.dwg

The concept is incorrect. To be equidistant, every point on the centerline must be the same distance (perpendicular) from the two margins.

Anyway, the result obtained by Dexus's code is one of the best (perhaps the best) I've found on the web. Thanks for that, Dexus

...Continue from previous post, experiment with imperial mod, quotient, division. ##********************************************************************************************** ## 45 UDF/ Excel name: impaMQD() - Similar Excel MOD() function with optional parmeters, ## return quotient or division [opt_1Quotient_or_2Division]. ## ## Note: This function uses todec() & toimpa() as sub-functions. ## ## Notes with optional parameters: ## ## [opt_1Quotient_or_2Division] = 1 , Similar Excel QUOTIENT() function - Returns the integer ## portion of a division ## [opt_1Quotient_or_2Division] = 2 , division calculation (varDividend/varDivisor) ## ## Optional parameters other than 1 & 2 will return error #N/A ## ## Rev. 1.0 - 9/2/2025 ##********************************************************************************************** =LAMBDA(varDividend,varDivisor,[opt_1Quotient_or_2Division], LET(optN,IF(ISOMITTED(opt_1Quotient_or_2Division),0, IF(AND(opt_1Quotient_or_2Division<=2,opt_1Quotient_or_2Division>0),opt_1Quotient_or_2Division,NA())), varD1,todec(varDividend), varD2,todec(varDivisor), answrM,varD1-(varD2*INT(varD1/varD2)), answrQ,ROUNDDOWN(varD1/varD2,0), answrD,varD1/varD2, SWITCH(TRUE, optN=0,IF(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),answrM,IF(OR(AND(ISTEXT(varDividend),ISTEXT(varDivisor)),ISNUMBER(varDivisor)),toimpa(answrM),"Error!")), optN=1,IF(OR(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),AND(ISTEXT(varDividend),ISTEXT(varDivisor))),answrQ,IF(ISNUMBER(varDivisor),toimpa(answrQ),"Error!")), optN=2,IF(OR(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),AND(ISTEXT(varDividend),ISTEXT(varDivisor))),answrD,IF(ISNUMBER(varDivisor),toimpa(answrD),"Error!")), NA() ) ) )

Since Lee's Code only has you picking a point its easy enough. Just add a call at the end of APV (line 95) to call itself again. This will force a loop that you have to hit esc to exit. - Edit This is a better option. Has undo marks. You could also set your snaps before entering the command if you want to. ;;----------------------------------------------------------------------------;; ;; Add Polyline Vertex loop ;; Dependent AddLWPolylineVertexV1-1.lsp (defun C:APVL ( / ) (vl-load-com) (princ "\nStarting Add Polyline Vertex loop. Press ESC to stop.") (vla-StartUndoMark (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))) ;(setvar 'OSMODE 3) ;End and mid point snaps (while T (C:APV) ) (princ "\nAdd Polyline Vertex Loop ended.") (vla-EndUndoMark doc) (princ) )

I think this is an extremely interesting problem that deserves significantly more lines of code than have been written so far in this thread. I believe those lines shouldn't be long in coming.

I think you're doing a very good job. PS: The animation in the GIF doesn't look the same as the one in the code.

I'm still sorting an attempt at the Bowyer–Watson version, but first I am trying to sort a few that are getting close. The export CSV and import a centerline is very close, but on the AxisExample .dwg it has a zig-zag glitch. I have one that draws the bisector lines that's close, but still misses the midpoint coming around those turns. I do have the one that appears very accurate on bends in one direction and the bends in the opposite direction depending on pick order. This would work if the AxisExample.dwg was in separate sections at the turns, maybe. I get a error: bad argument type: fixnump: nil with the AxisExample.dwg and some other errors on the original Example.dwg (Two vertices were added to a 2D pline (0) which had no vertices. and error: bad argument type: numberp: nil ) though the simple ones it draws the centerline with @marko_ribar's version. Every one of these fall short on the OPs AxisExample drawing, most in the same areas. So, I will probably keep at this for a while to see how close I can get it. For sure, nearly everyone of these are as good as and many much better than, the currently available solutions in AutoCAD. The solution suggested by Autodesk, PathAverage.lsp by Kent Cooper, fails miserably on most of the OP's examples, though seems to work in most cases and needs the polylines in the same direction. I still have work to do for my paying job, but hopefully I can bang out something soon.

For fun, an another old code (in French) trapeze_dyn.lsp

If you want 30 degree use (* (/ 1.0 6.0) pi) My $0.05 the front end can preset values but change as required. (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter Values" "Base Width " 5 4 "100" "Height " 5 4 "100" "Angle" 5 4 "30" ))) (setq Wid (atof (nth 0 ans)) ht (atof (nth 1 ans)) ang (atof (nth 2 ans))) (setq ang (* pi (/ ang 180.0))) Multi GETVALS.lsp

@Nikon IMHO - the extra variables that mhupp referenced in his example are unnecessary, and you didn't localize them. I'd recommend you simplify to this: (defun c:trapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar '(lambda (x) (cons 10 x)) (list p1 p2 p3 p4)) ) ) ) ) )

@mhupp that works fine. I personally think the benefits are extremely tiny on such a simple code form. For short routines, I tend to just use the command sequence. On more intensive stuff I use the ActiveX entity creation more often then using entmake with DXF codes.

Here's my quick version: (defun c:trapezoid (/ bw p0 p1 p2 p3 p4 ra sa th) (if (and (setq bw (getreal "\nEnter the width of the Base: ")) (setq th (getreal "\nEnter the Height: ")) (setq sa (getreal "\nEnter the side angles: ")) (setq p0 (getpoint "\nSelect the insertion point: ")) ) (progn (setq ra (* pi (/ sa 180.0)) p1 (list (- (car p0) (/ bw 2)) (cadr p0) (caddr p0)) p2 (list (+ (car p1) bw) (cadr p0) (caddr p0)) p3 (list (+ (car p2) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) p4 (list (- (car p1) (* (/ th (cos ra)) (sin ra))) (+ (cadr p0) th) (caddr p0)) ) (command-s "._pline" "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_c") ) ) )

I think you should rename the variable 'angle': 'angle' is a language symbol, that is, a function. Try changing it to 'ang', for example.

You can limit what ssget selects by entity, layer, color, size, basically anything in dxf codes. please read up on ssget This means you could just make a window selection. And not have to zoom in and out to make selections. also @Steven P already said "ssadd does a check if the entity exists in the set" check the length of SS before and after to see if it was already in the list. also also looks like your not using localized variables could be why its taking so long. (defun C:123 ( / ss pick l) (setq ss (ssadd)) (princ "\nSelect Entity: ") (while (setq pick (ssget)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex pick))) (setq l (sslength ss)) ; Length before adding (setq ss (ssadd ent ss)) ; Try adding entity (if (= l (sslength ss)) ; If length is the same, item was already in list (princ "\n\nDuplicate Selected Line") ) ) (princ (strcat "\n" (itoa (sslength ss)) " Entities now in Selection SS")) ) ; rest of code goes here (princ) ) (defun C:bm ( / ss ent) (while (setq SS (ssget (ssget "_+.:E:S"))) ;exits if selection isn't made (setq ent (ssname ss 0)) ;CODE ) )

Case 1: ssadd does a check if the entity exists in the set, you can change CASE 1 (setq ss (ssadd)) (if (not (ssmemb n ss)) (ssadd n ss) ;code );if to CASE 1 (ssadd n ss) ;code Often in code optimisation is rarely a single line that makes a difference... unless you are doing thousands of calculations, so here taking out an if statement won't do a lot. Most likely you have a loop within a loop that slows things - might be more efficient to look back at how you are selecting the entities and processing them before adding to the selection set. However don't just accept that, if you code will work without the line take out your if statement, and ssadd and you shouldn't really notice a big difference in speed

"Plines in same direction", Yes Lee-Mac has a method also. Note the use of Pedit as Bricscad does not have a "Reverse" command, as at V25. ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; By Alan H July 2020 (defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint) (setq obj (vlax-ename->vla-object ent)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (command "Pedit" ent "R" "") ) (princ) ) (defun c:CWCCW ( / *error* x ent oldsnap doc ss) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (prompt (strcat "\nSelect Plines to check")) (if (setq ss (ssget '((0 . "*POLYLINE")))) (progn (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (AH:chkcwccw ent) ) ) ) (vla-endundomark doc) (alert (strcat (rtos y 2 0) " Plines reversed")) (setvar 'osmode oldsnap) (princ) ) (vl-load-com) (prompt "\nType CWCCW to set plines to CCW") (c:CWCCW)

From what I have gathered, no easy task to do this, many GIS programs seem to struggle with pinpoint accuracy as well. The method for QGIS, is involved, so I didn't get time to run through it with the plugin, but I did dig into reddit and some GIS sites. Basically they do similar method, they just add a lot of points down the "polyline/line" and run the appropriate "centerline tool". Where someone posted results, I saw some in some of them the same "off center through some areas" as in the methods posted here. This was apparently plenty good enough for most GIS users, though I only did a relatively quick dig. In a similar method for AutoCAD, maybe adding more points to the polylines would help. I might have time Monday at home to check QGIS. Though I did import the OPs drawings into a session, the first one comes in very strange, the second seemed to be correct. The OP still hasn't answered why the second .dwg posted comes up as not an AutoCAD drawing. For AutoCAD, it helps if BOTH polylines go the same direction.

My $0.05 does not check for off or frozen layers. (defun c:wow ( / ent co-ord ss) (if (tblsearch "layer" "Site") (princ) (command "-layer" "Make" "Site" "c" 1 "" "") ) (if (tblsearch "layer" "Exist") (princ) (command "-layer" "Make" "Exist" "c" 2 "" "") ) (command "chprop" "all" "" "la" "Site" "") (setq ent (car (entsel "\nPick the pline "))) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq ss (ssget "WP" Co-ord)) (command "chprop" ss "" "LA" "Exist" "") (princ) ) (c:wow)

yes you can. Add a filter for wall using Type Name and apply that filter in View. hit VG and edit the filter CUT Properties according to your liking. Turn off Thin Lines to check the line thickness.

Autocad EXTRIM command, select polygon and click outside