All Activity

Hi I've attached a small revision of @ymg3's excellent code that further improves speed. Tested on this drawing (3200 polylines) Ax.dwg ;; 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. ; ;; ; ;| Added or revised code by GLAVCVS (january 2026) -All set are grouped into one -An associative sparse matrix cell->handles is created for faster cell querying (using new 'addToDict' and 'getCell' functions) -The "edges" list is replaced with the local search retourned by 'getCell' T E S T S ===== fas: 4-5 x faster than previous fas lsp: 7-8 x faster than previous lsp |; (defun c:A* (/ sspl i edges startp endp openlst closelst found acdoc Edgelay Pathlay Pathcol Pathlwt lstClvs ) (vl-load-com) ; Changes values of following 4 global variables to suit your need. ; (setq Edgelay "0" Pathlay "0" 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)) ;;; (addToDict en) ;;; (setq edges (append edges (mk_edge (listpol2d en)))) ;;; ) ;;; nil ;;; ) ;;; ;;; (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 ;;; ) ;;; ) ;;; ) ;;; ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;ADDED by GLAVCVS (prompt "\rWait...\n") (vla-update (vlax-get-acad-object)) (if (setq sspl (ssget "X" (list '(0 . "*LINE") (cons 8 EdgeLay)))) (foreach en (mapcar (function cadr) (ssnamex sspl)) (addToDict en) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;ADDED by GLAVCVS ;;;Create dictionary (defun addToDict (en / p1 p2 id clv) (setq p1 (vlax-curve-getStartPoint en) p2 (vlax-curve-getEndPoint en) id (cdr (assoc 5 (entget en))) ) (foreach p (list p1 p2) (if (setq val (assoc (setq clv (strcat (itoa (fix (car p))) "-" (itoa (fix (cadr p))))) lstClvs)) (setq lstClvs (subst (append val (list id)) val lstClvs)) (setq lstClvs (cons (list clv id) lstClvs)) ) ) ) ;;;return list cell (defun getCell (pt / clv v lr) (if (setq val (assoc (setq clv (strcat (itoa (fix (car pt))) "-" (itoa (fix (cadr pt))))) lstClvs)) (foreach e (cdr val) (setq lr (cons (list (butlast (vlax-curve-getStartPoint (handent e))) (butlast (vlax-curve-getEndPoint (handent e)))) lr)) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ; ;; 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 / lEdges edge pt fcost p1 p2 d temp) (setq pt (car node) fcost (caddr node) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;added By GLAVCVS (setq lEdges (getCell pt)) (foreach edge lEdges (setq p1 (car edge) p2 (cadr edge) d (distance p1 p2) temp nil ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (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 ; (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) )

Glad to hear that.

@Kumar1 I'm afraid your not going to get a completely automated solution. It might be possible, I'm not sure, but would take a great deal more code to sort and determine the closest curves. This is something I don't have time to write for you. The solution I gave you works if you select the points, then the curve for each set of dims. I leave it to you to sort out what you want from our examples. P.S. Some of your "points" are actually block references, you should better represent what you want. I am updating the code above to include block references, which will get their insertion point..

dimension to be perpendicular to the lines nearby

Auto dimensiong - Project 1.dwg dimensions to be added as shown in the dwg by selecting multiple points and lines near by.

As I said, this code doesn't work in some special cases. However, in the cases where it does work, it returns surprising results. I've attached a short video to illustrate this. CLG_xple.mp4

I don’t know which program can obtain the best equidistant centerline. But it shouldn’t be very different from what you can achieve with this code. ;********************************************************************** ;************************ G L A V C V S *************************** ;******* COMPLVRES • HORAS • VITAE • SVAE • IN • HOC • CODICE ******* ;***************** VT • TIBI • MAGNO • VSVI • SVIT ******************** ;********************************************************************** (defun c:CLG (/ PI/2 t/2 tol lst e1 e2 l1 l2 lp lp1 lp2 p0 p> p< r1? x m a ap =e1 ee c?1 pp+ c?2 NoEq lps lf lst lt pu *mU *pU *pB lSgmt *sombra* autoInt? ordenaPts interCpta ptEqd asr flanquea afina p>< pp px n lprs lpp lpr1 *pr1 p· ) (defun autoInt? (p1 p2 lp / p0 p1 p2);check if p1-p2 intersects lp list / autointerseccion? (vl-some '(lambda (p) (if p0 (inters p0 (setq p0 p) p1 p2) (not (setq p0 p)))) lp) ) (defun asr (pa pb p1 / ar ang ab); angle right/left ? / define el lado al que se encuentra el otro margen (cond ((< (abs (setq ang (- (setq ar (angle pa pb)) (setq ab (angle pb p1))))) PI) ang) (T (if (<= ar PI) (+ ar (- (* 2 PI) ab)) (- (- ar (* 2 PI)) ab))) ) ) (defun afina (lst / p0 p1 p2 s1 s2 pB lrr lar i pQbro p);this function gets break points on center-line / esta función obtiene los puntos de inflexion de la linea central (if (> (length lst) 3) (progn (foreach p lst (if p0 (if p1 (setq lar (cons (list (abs (asr p0 p1 p)) p0 p1 p (setq i (if i (1+ i) 0))) lar) p0 p1 p1 p) (setq p1 p) ) (setq p0 p) ) ) (setq lar (vl-sort lar '(lambda(a b) (> (car a) (car b)))) i -1) (if (or (= (length lar) 2) (> (car (nth 1 lar)) (* (car (nth 2 lar)) 5.))) (progn (if (= (abs (- (setq p1 (last (car lar))) (setq p2 (last (cadr lar))))) 1) (if (< p1 p2) (setq s1 (list (cadr (car lar)) (caddr (car lar))) s2 (list (caddr (cadr lar)) (cadddr (cadr lar)))) (setq s1 (list (cadr (cadr lar)) (caddr (cadr lar))) s2 (list (caddr (car lar)) (cadddr (car lar)))) ) ) (if (and s1 s2) (if (setq pQbro (inters (car s1) (cadr s1) (car s2) (cadr s2) nil)) (while (setq p (nth (setq i (1+ i)) lst)) (setq lrr (if (= i (max p1 p2)) (cons pQbro (cons p lrr)) (cons p lrr))) ) ) ) (simplifPts lrr 0.001) ) (simplifPts lst 0.001) ) ) lst ) ) (defun ordenaPts (lst pIni / p dm d ps? ps pa lr xx =a) ; sort list points / ordena los puntos (while lst (foreach p lst (if (and dm (/= (min (setq d (distance (if ps ps pIni) p)) dm) dm)) (if (or (not lr) (not pa) (< (abs (asr pa ps p)) (/ PI 2.)) ) (setq dm d ps? p) ) (if (not dm) (if pa (if (< (abs (asr pa ps p)) (/ PI 2.)) (setq dm (distance ps p) ps? p) ) (setq dm (distance (if ps ps pIni) p) ps? p) ) ) ) ) (if (setq =a (equal ps? pa 1e-4)) (setq lst (vl-remove ps? lst) ps? nil dm nil) (setq pa ps ps ps? ps? nil dm nil lst (vl-remove ps lst) lr (cons ps lr)) ) ) lr ) ;;; This function projects normals and angle bisectors to the other edge ;;; Esta función proyecta normales y bisectrices hasta el otro margen (defun interCpta (pM p1 p2 lp / i? fueraSombra? i1 i2 d p b x lpe); pM: mid point / pm: es el punto medio a emplear como base. (defun fueraSombra? (p); 'pcu': last 'closestpoint' successful / 'pcu' ES EL ULTIMO 'closest' EXITOSO (if (minusp (* (asr p (car *lpB) (car *lpU)) *sombra*)); if returned sign chamged to 'asr', came out of the shadows (*sombra*) / es decir, si cambió el signo devuelto por 'asr' entonces salimos de la sombra (setq *sombra* nil p (list p (car *lpU))) ) ) (defun i? (pA pB lp / p0 i dm is a) (foreach p lp (if p0 (if (setq i (inters p0 (setq p0 p) pA pB)) (if (and dm (/= (min (setq d (distance pM i)) dm) dm)) (if (not (autoInt? (polar pM (setq a (angle pM i)) 1e-3) (polar i (+ a PI) 1e-3) lpe)) (setq dm d is i) ) (if (and (not dm) (not (autoInt? (polar pM (setq a (angle pM i)) 1e-3) (polar i (+ a PI) 1e-3) lpe))) (setq dm (distance pm i) is i) ) ) ) ) (setq p0 p) ) (if is (list (car is) (cadr is) 0.0) ) ) (setq lpe (if (equal e e1) lp1 lp2)) (if (and pM p1 p2 (or (setq p (i? p1 p2 lp)) (not (autoInt? (setq pu (vlax-curve-getClosestPointTo ee pM)) (polar pM (angle pM pu) 1e-3) lpe)))) (list pM (if p p (setq *mU m *pB pM *sombra* nil *pU pu))); *pU: last closest point on another edge / RECUERDA QUE *pU ES EL PUNTO CLOSETEADO ULTIMO EN EL OTRO MARGEN (if *sombra* (fueraSombra? pM) (if *pU; *pU SOLO SE CARGÓ CUANDO EL RESTO DE OPCIONES (normales y bisectriz) NO FUNCIONARON (if (autoInt? (setq x (if *lpU (car *lpU) *pU)) (polar pM (angle pM x) 1e-3) lpe);|If it also self-intecsects when searching for the last sucessfully closest point|; ;|SI TAMBIÉN SE AUTOINTERSECA AL BUSCAR EL ÚLTIMO PUNTO 'CLOSETEADO' EXITOSAMENTE|; (setq *sombra* (if (= (abs (- m *mU)) 1) (asr pM *pB *pU)) *lpU (cons *pU *lpU) *lpB (cons *pB *lpB) p nil) (if *lpU (list pM (car *lpU))) ) (alert "EXCEPTION!") ) ) ) ) (defun ptEqd (A B e1 e2 / eqDistf t0 t1 f0 f1 tm fm n i v+- v*); get eqdist point / captura punto equidistante (defun v+- (o a b) (mapcar o a b)) (defun v* (p s) (mapcar '(lambda (x) (* x s)) p)) (defun eqDistf (ds A B e1 e2 / pt d1 d2 p1) (setq pt (v+- '+ A (v* (v+- '- B A) ds)) d1 (distance pt (setq p1 (vlax-curve-getClosestPointTo e1 pt))) d2 (distance pt (vlax-curve-getClosestPointTo e2 pt)) *pr1 (vlax-curve-getParamAtPoint e1 p1) ) (- d1 d2) ) (setq t0 0.0 t1 1.0) (while (and (< (setq n (if n (1+ n) 0)) 100) (> (- t1 t0) 1e-6));bisection method/método de bisección (setq tm (/ (+ t0 t1) 2.0) fm (eqDistf tm A B e1 e2) ) (if (< (abs fm) 1e-9) (setq n 100 t1 tm t0 tm) (if (< (* (if f0 f0 (eqDistf t0 A B e1 e2)) fm) 0.0) (setq t1 tm f1 fm) (setq t0 tm f0 fm) ) ) ) (if (< t1 1.0) ; final parameter and eqdist point / parámetro final y punto equidistante (v+- '+ A (v* (v+- '- B A) (/ (+ t0 t1) 2.0))) ) ) (defun simplifPts (lst tol / po p0 p1 p> p a lr le np x);simplify list point / simplifica la lista de puntos (foreach p lst (if p0 (if p1 (if (setq po (inters p0 (polar p0 (setq a (angle p0 p1)) 1) p (polar p (+ a (/ pi 2)) 1) nil)) (if (> (distance po p) tol) (setq le (cons p1 le) p0 p1 p1 p x (if x (1+ x) 2) ) ; including point / si hay que incluir el punto (setq p1 p);deleting point/si hay que suprimirlo ) ) (setq p1 p) ) (setq p0 p le (cons p le)) ) (if (equal p (last lst) 1e-4) (setq le (cons p le))) ) le ) (defun flanquea (p0 p tol / pM px pEqd a d); It obtain points for the agreement between segments according tolerance / Obtiene los puntos para acuerdo de segmentos respetando tolerancia (setq pM (list (/ (+ (car p0) (car p)) 2.) (/ (+ (cadr p0) (cadr p)) 2.)) pEqd (ptEqd (setq pA (polar pM (setq a (+ (angle p0 p) (/ PI 2.))) 50)) (setq pB (polar pM (+ a PI) 50)) e1 e2) ) (if (> (distance pEqd pM) tol) (progn (setq lf (cons pEqd lf));saving / guardamos (if (not (member *pr1 lpr1)) (setq lpr1 (cons *pr1 lpr1))) (flanquea p0 pEqd tol) (flanquea p pEqd tol) ) ) (append lf (list p0 p)) ) (vl-catch-all-apply '(lambda() (if (and (setq e1 (car (entsel "\nSelect FIRST LWPolyline..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") ) (if (and (setq e2 (car (entsel "\nSelect SECOND LWPolyline..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") ) (progn (foreach l l1 (if (= (car l) 10) (setq lp1 (cons (cdr l) lp1)))) (foreach l l2 (if (= (car l) 10) (setq lp2 (cons (cdr l) lp2)))) (if (setq c?1 (= (rem (cdr (assoc 70 l1)) 2) 1)) (setq lp1 (cons (last lp1) lp1)) (setq c?1 (equal (car lp1) (last lp1) 1e-4)) ) (if (setq c?2 (= (rem (cdr (assoc 70 l2)) 2) 1)) (setq lp2 (cons (last lp2) lp2)) (setq c?2 (equal (car lp2) (last lp2) 1e-4)) ) (if (not c?1) (setq r1? (> (distance (car lp1) (car lp2)) (distance (car lp1) (last lp2))))) (setq tol (getreal "\nMaximum tolerance for equidistance within segments <0.005> : ") ; tolerance adjust / AJUSTAR TOLERANCIA AQUI tol (if tol tol 0.005) PI/2 (/ PI 2.) lp1 (if r1? (reverse lp1) lp1) t/2 (/ tol 2.) *lpB nil *lpU nil ) (foreach e (list e1 e2) (setq p0 nil m nil r? (if (setq =e1 (equal e e1)) r1?) lp (if =e1 lp2 lp1) c? (if =e1 c?1 c?2) ee (if =e1 e2 e1)) (while (setq p (vlax-curve-getPointAtParam e (setq m (if m ((if r? 1- 1+) m) (if r? (vlax-curve-getEndParam e) 0))))) (setq pu nil n1 nil n2 nil n3 nil) (if p0 (progn (setq lAB (interCpta p (polar p (setq a (+ (angle p0 p) PI/2)) 1e6) (polar p (+ a PI) 1e6) lp); normal at the begining of the segment / NORMAL AL COMIENZO DEL SEGMENTO lst (if lAB (cons (setq n1 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) (if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m))); (setq lAB (interCpta p (polar p (setq a (/ (+ (angle p p0) (angle p p>)) 2.)) 1e6) (polar p (+ a PI) 1e6) lp); bisector / Bisectriz lst (if lAB (cons (setq n2 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) lAB (interCpta p (polar p (setq a (+ (angle p p>) PI/2)) 1e6) (polar p (+ a PI) 1e6) lp); normal at the ending of the segment / NORMAL AL FINAL DEL SEGMENTO lst (if lAB (cons (setq n3 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) ) (setq p< p0 p0 p) ) (if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m))) (progn (setq lAB (interCpta p (polar (setq p0 p) (setq a (+ (angle p0 p>) PI/2)) 1e6) (polar p0 (+ a PI) 1e6) lp);normal at the begining of the segment / NORMAL AL COMIENZO DEL SEGMENTO lst (if lAB (cons (setq n1 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) (if c? (setq lAB (interCpta p (polar p (setq a (/ (+ (angle p (vlax-curve-getPointAtParam e (1- (vlax-curve-getEndParam e)))) (angle p p>)) 2.)) 1e6) (polar p (+ a PI) 1e6) lp ) lst (if lAB (cons (setq n2 (ptEqd (car lAB) (cadr lAB) e1 e2)) lst) lst) ) ) ) ) ) ) ) (setq lst (cdr (simplifPts (reverse (ordenaPts lst (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car lp1) (car lp2)))) 0.001)) p0 nil n -1) (if (and c?1 c?2) (setq lst (cons (last lst) lst))) (while (setq p (nth (setq n (1+ n)) lst)) (if p0 (if (or (and pa (setq pp (nth (1+ n) lst)) (setq p>< (inters pa p0 p pp nil)); intecsections of extensions / intersección de las prolongaciones (setq px (inters p0 p p>< (polar p>< (+ (angle p0 p) (/ pi 2)) 1) nil)); distance to the base segment / distancia al segmento base (> (distance p>< px) tol); separation greather than tolerance / si la separacion es superior a la tolerancia ) (and c?1 c?2) ) (setq pM (list (/ (+ (car p0) (car p)) 2.) (/ (+ (cadr p0) (cadr p)) 2.)) NoEq (> (setq df (/ (abs (- (distance pM (vlax-curve-getClosestPointTo e1 pM)) (distance pM (vlax-curve-getClosestPointTo e2 pM)))) 2.)) t/2) pp+ (if NoEq (if (< df tol) (if (setq p· (ptEqd (polar pM (setq a (+ (angle p0 p) PI/2)) 5) (polar pM (+ a PI) 5) e1 e2)) (progn (if (not (member *pr1 lpr1)) (setq lpr1 (cons *pr1 lpr1))) (list p0 p· p) ) ) (afina (ordenaPts (flanquea p0 p t/2) p0)) ) ) lf nil ) (setq pp+ nil) ) ) (setq lt (if p0 (cons p0 lt) lt) pa p0 p0 p ap a) (if pp+ (foreach v (reverse (cdr (reverse (cdr pp+)))) (setq lt (cons v lt)))) ) (setq lt (ordenaPts (simplifPts lt 0.001) p0)) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "0") '(100 . "AcDbPolyline") (cons 90 (length lt)) ) (foreach p lt (setq lps (cons (list 10 (car p) (cadr p)) lps)))) ) (if (or c?1 c?2) (entmod (append (entget (entlast)) '((70 . 1))))) ) ) ) ) ) (princ) ) It is an improvement over the last code I posted. However, I have abandoned this variant because, as you rightly pointed out in your previous post, it doesn’t work in some of your drawings, and fixing it turns out to be more complicated than is reasonably justified. Also, as I mentioned before, this approach is more brute-force and slower. Still, it is useful to illustrate what can be done in drawings like this. For that reason, I decided to publish it now. In my opinion, the best equidistant centerline should achieve everything that is possible and bound what is impossible within a tolerance. What is possible: Vertices: – all points or vertices of the centerline can and therefore must be equidistant. Segments: – all centerline segments that result from the overlap of segments on both margins (80/90%) must also be equidistant along their entire length. What is impossible: Segments: – the interior of segments that do not meet the previous condition cannot be geometrically equidistant, BUT their maximum “non-equidistance” should be bounded by a tolerance. Based on these criteria, for polylines representing linear entities such as rivers, roads, etc., this code should for tolerances down to 1 millimeter (the smaller the tolerance, the larger the resulting time&geometry).

YOU ARE MY SAVIOR, BRO!!!

Trying to find it again. Give this a try. You pick points in sequence it will draw offsets, make sure you press Enter to finish picking points as it will fillet all the offset segments. offset sides pline.lsp

There is something that might be interesting: what is the best equidistant centerline that can be obtained with other programs? If anyone has a specialized tool for this, it would be very interesting if they could attach a DXF with the result for the drawing in my previous post.

My daily job is mainly about electrical diagrams and loops so I'm afraid I pretty much have zero knowledge about anything mechanical or civil stuff. Probably best to take on Bigal's offer. Last time I checked he doesn't ask for one of your organs , part of your brain or any other body parts , just a cup of coffee or a nice cold beer. I believe Tharwat is also one of those people with lots of experience and he also has his own site with some cool stuf.

After being too busy working on my 2025 financial balance, I’ve had a bit of time to test the latest published codes. In addition, I found a new “toy” to test them with. To see the result in detail, you can download the attached drawing. Another.dwg In the images I show some examples of what I have observed: There are still some significant errors in the equidistance of the centerline. The latest code by glavcvs seems to always achieve equidistance at all points. However, inside some segments there are errors of more than 1 meter. I assume this is an issue that glavcvs has already solved but apparently has not yet published. The code by dexus has similar problems, but in addition there are also some points with significant errors in equidistance. Finally, I have also noticed that the latest code by glavcvs does not work on some of the drawings attached as examples in this thread. I suppose we are going very far— further than what was initially intended. For most people who come across this, this will probably be sufficient. But “immortality is always a little further ahead.” Many thanks to everyone who has participated in this so far and to those who will do so in the future!

Here is a boiled down simple version with no error testing. It assumes that the dimensions will run on the same angle as the angle between the point and the curve segment: ;; Created by P. Kenewell 1/22/2026 (defun c:dim2pts (/ ep i p1 p2 p3 ss) (if (and (progn (princ "\nSelect Points to Dimension: ") (setq ss (ssget '((0 . "POINT,INSERT")))) ) (setq ep (entsel "\nSelect a curve to Dimension to: ")) ) (repeat (setq i (sslength ss)) (setq p1 (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object (car ep)) p1) p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)) ) (command "._dimrotated" (* (/ (angle p1 p2) pi) 180.0) "_non" p1 "_non" p2 "_non" p3) ) ) (princ) ) Example Screenshots:

@Kumar1 please make or send a real dwg , with points-layer, line-layer, dim-layer and a new dimstyle not an overrided style, so all variables system are stated . Like the first DWG posted at this topic Dimension from Point to line.dwg

@rlx Kindly assist to resolve this. Thanks.

ptsalign should do it.

This is a fairly common Paper Space / viewport issue rather than a problem with your model. What you’re seeing is facet aliasing caused by how AutoCAD displays and plots shaded viewports, especially when using the BASE command. Model Space looks fine because it’s using higher real-time display resolution; Paper Space viewports are rasterized differently. Here are the things that usually fix it: 1. Increase viewport display resolution AutoCAD uses a lower tessellation for shaded viewports by default. In Model Space, type: FACETRES Set it to: 10 (Valid range is 0.01–10, higher = smoother curved/diagonal edges) Then REGENALL. 2. Check VIEWRES Still in Model Space: VIEWRES Answer Yes to fast zooms Set it to something like: 2000 This affects how smooth diagonal edges appear when displayed. 3. Viewport Visual Style In Paper Space, select the viewport and confirm: Visual Style = Shaded or Shaded with Edges Not Conceptual or Realistic (those can exaggerate faceting) You can also try: SHADEDGE Set to: 3 (Smooth edges without heavy outlines) 4. Plot settings (very important) When plotting to PDF: Plotter: DWG To PDF.pc3 In Properties → Graphics: Set Vector Resolution to 1200 dpi Set Raster Image Quality to High Make sure Plot transparency is ON (even if you’re not using transparency) Low raster resolution is a major cause of jagged diagonal shading. 5. BASE command note The BASE command creates a Paper Space representation that behaves like a shaded viewport. It’s more sensitive to resolution than raw Model Space views. Increasing FACETRES and plot resolution almost always fixes this. 6. Quick test As a sanity check: Create a normal viewport (not BASE) Set it to the same view and visual style Plot it If the jagged edges disappear, the issue is 100% display/plot resolution related, not geometry.

this lisp is fine, but instead of picking each point, can we write a lisp routine to select multiple points and write dimension automatically. Sample File uploaded above.

this lisp is fine, but instead of picking each point, can we write a lisp routine to select multiple points and write dimension automatically.

AutoDimensioning-VV.dwg

I've included another video as an example. smart offset.mp4

Thank you for your answers. The Lisp code you described might be useful, but as you said, when traversing areas like walls or columns, it offsets the line by 6 units, and if there's a pre-drawn, offset line, it follows it all the way to the end. Could you share your code? @BÜYÜK

I did something for water pipes or electric cables in a road, it just allows you to follow line segments, with a predefined offset. I am not sure though in your last bit of Video if you want to enter the length of the last leg, can you clarify that. The code I have draws a full last length. @ScottMC not sure that overall length is required. Just a ps did you mean to post the actual code as you have the lisp file to download.

Here's a useful Lee.Mac Power.tool TotalLengthPolylineV1-0.lsp

Hi, I need a smart and dynamic offset Lisp when drawing electrical projects. polyline will follow the wall. Like in the video. ScreenRecording_01-20-2026 22-20-40_1.mov