Leaderboard
Popular Content
Showing content with the highest reputation on 01/23/2026 in all areas
-
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.mp43 points
-
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).3 points
-
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.lsp1 point
-
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:1 point
