Leaderboard

Why get fancy? (max 0 (- botLength 6000))

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).

@Danielm103 How can AI be better than human revision? Here is AI - I've added "red" color... (defun c:ortho_pline ( / orthogonalize-points edata ent newpts p pl pts x) (defun orthogonalize-points (pts / dx-in dx-out dy-in dy-out i in-is-h new-x new-y out-is-h p0 p1 p2 result) ;; If fewer than 3 points, nothing to do (if (< (length pts) 3) pts (progn (setq result pts) ;; Iterate interior vertices (setq i 1) (while (< i (- (length pts) 1)) (setq p0 (nth (- i 1) result)) (setq p1 (nth i result)) (setq p2 (nth (+ i 1) result)) ;; Incoming vector p0 -> p1 (setq dx-in (- (car p1) (car p0))) (setq dy-in (- (cadr p1) (cadr p0))) ;; Outgoing vector p1 -> p2 (setq dx-out (- (car p2) (car p1))) (setq dy-out (- (cadr p2) (cadr p1))) ;; Dominant direction tests (setq in-is-h (>= (abs dx-in) (abs dy-in))) (setq out-is-h (>= (abs dx-out) (abs dy-out))) ;; Case 1: Proper corner (one horizontal, one vertical) (cond ((/= in-is-h out-is-h) (if in-is-h (progn ;; incoming horizontal, outgoing vertical (setq new-x (car p2)) (setq new-y (cadr p0)) ) (progn ;; incoming vertical, outgoing horizontal (setq new-x (car p0)) (setq new-y (cadr p2)) ) ) ) ;; Case 2: both horizontal (in-is-h (setq new-x (car p1)) (setq new-y (cadr p0)) ) ;; Case 3: both vertical (t (setq new-x (car p0)) (setq new-y (cadr p1)) ) ) ;; Replace interior point (setq result (subst (list new-x new-y) p1 result)) (setq i (1+ i)) ) result ) ) ) (setq ent (car (entsel "\nSelect a polyline: "))) (if (not ent) (progn (princ "\nNothing selected.") (exit) ) ) (setq edata (entget ent)) ;; Ensure LWPOLYLINE (if (/= (cdr (assoc 0 edata)) "LWPOLYLINE") (progn (princ "\nEntity is not a lightweight polyline.") (exit) ) ) ;; Extract vertices (group code 10) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))) ;; Orthogonalize (setq newpts (orthogonalize-points pts)) ;; Create new polyline (setq pl (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length newpts)) '(70 . 0) ) (mapcar '(lambda (p) (cons 10 p)) newpts) (list '(62 . 1)) ) ) ) (if pl (princ "\nOrthogonal polyline created.") (princ "\nFailed to create polyline.") ) (princ) ) And here is my version - I used "green" color... (defun c:lw_orth ( / un f lw lwx pl cl ) (defun un ( l / a ll ) (while (setq a (car l)) (if (vl-some (function (lambda ( x ) (equal x a 1e-10))) l) (setq ll (cons a ll) l (vl-remove-if (function (lambda ( x ) (equal x a 1e-10))) (cdr l))) (setq ll (cons a ll) l (cdr l)) ) ) (reverse ll) ) (defun f ( l / i p1 p2 r ) (if (> (length l) 2) (progn (setq i -1) (while (< (setq i (1+ i)) (1- (length l))) (if (not p1) (setq p1 (nth i l) p2 (nth (1+ i) l)) (setq p1 p2 p2 (nth (1+ i) l)) ) (if (= i 0) (setq r (cons (car l) r)) ) (if (< (abs (- (car p2) (car p1))) (abs (- (cadr p2) (cadr p1)))) (setq r (cons (setq p2 (list (car p1) (cadr p2))) r)) (setq r (cons (setq p2 (list (car p2) (cadr p1))) r)) ) (if (= i (- (length l) 2)) (setq r (cons (last l) r)) ) ) (setq r (reverse r)) (un (apply (function append) (mapcar (function (lambda ( p1 p2 / pp ) (if (setq pp (vl-some (function (lambda ( x ) (if (and (equal (distance p1 p2) (+ (distance p1 x) (distance x p2)) 1e-10) (not (equal x p1 1e-10)) (not (equal x p2 1e-10))) x))) l)) (list p1 pp) (list p1)))) r (append (cdr r) (list (car r)))))) ) ) ) (if (and (setq lw (car (entsel "\nPick polygonal lwpolyline to make its clone orthogonalized..."))) (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE") (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) lwx)) ) (progn (if (or (= (cdr (assoc 70 lwx)) 1) (= (cdr (assoc 70 lwx)) 129)) (setq cl t) ) (setq pl (mapcar (function (lambda ( p ) (trans p lw 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))) (if cl (setq pl (append pl (list (car pl)))) ) (if (> (length pl) 2) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length (setq pl (f pl)))) (cons 70 (if cl (1+ (* 128 (getvar (quote plinegen)))) (* 128 (getvar (quote plinegen))))) (cons 38 0.0) ) (mapcar (function (lambda ( x ) (cons 10 x))) (mapcar (function (lambda ( p ) (trans p 1 lw))) pl)) (list (cons 62 3) (list 210 0.0 0.0 1.0) ) ) ) (prompt "\nPicked lwpolyline with insufficient number of vertices...") ) ) (prompt "\nMissed, or picked entity not polygonal lwpolyline... Better luck next time...") ) (princ) ) In attached *.DWG you can see that AI version makes mistake with finalizing segment - it isn't always orthogonal... Anyway interesting and fun for coding... Regards, M.R. orthogonalize_lwpolyline.dwg

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:

(if (= (minusp botLength) T) ;; verifies that a number is negative (setq botLength 0) ;; if it is, it will set to 0 (setq botLength (- botLength 6000)) ;; if it isn't, it will be substracted with "6000" )

You mean like this? (if (minusp botLength) 0 (- botLength 6000))

"Modelspace, paperspace or both?" looks like @Chicane_Apex has left the building, just like Elvis.

A slightly blunter method I use is to line everything up to a grid spacing (in my LISP I define the spacing rather than the drawing.... just in case) which usually works OK for most thing. A lot of what I do is line diagrams and the polylines are never too far out. - Get a list of points, use Lee Macs round to closest on each point, entmod the line using original and new points. I'd prefer entmod than making a new line just in case something goes wrong in between deleting the original and creating the new, retains all the original polyline info.

Another example. This allows you to select a closed polyline and hatch it by aligning itself to the side of the selection point. (vl-load-com) (defun c:hatch_align_vtx ( / AcDoc flag *error* f_pat ent Space pr-1 pr-1 alpha hatch) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) flag T) (vla-StartUndoMark AcDoc) (defun *error* (msg) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (if (= 8 (logand (getvar "UNDOCTL") 8)) (vla-endundomark AcDoc) ) (princ) ) (if (not (findfile "BAT_PUBL.pat")) (progn (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\BAT_PUBL.pat") "w")) (write-line "*BAT_PUBL" f_pat) (write-line "45,0,0,0,.75" f_pat) (write-line "315,0,0,0,.75" f_pat) (close f_pat) ) ) (while (setq ent (entsel "\nSelect the long side polyline to hatch it: ")) (setq obj_curv (vlax-ename->vla-object (car ent))) (cond ((and (eq (vlax-get-property obj_curv 'ObjectName) "AcDbPolyline") (eq (vla-get-closed obj_curv) :vlax-true) ) (setq Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) pr-1 (fix (vlax-curve-getParamAtPoint obj_curv (vlax-curve-getClosestPointTo obj_curv (cadr ent) nil))) pr+1 (if (>= (1+ pr-1) (fix (vlax-curve-getEndParam obj_curv))) 0 (1+ pr-1)) alpha (+ (angle (vlax-curve-getPointAtParam obj_curv pr-1) (vlax-curve-getPointAtParam obj_curv pr+1)) (* 0.25 pi)) ) (setq hatch (vla-AddHatch Space acHatchPatternTypeCustomDefined "BAT_PUBL" :vlax-True)) (vlax-invoke hatch 'AppendOuterLoop (list obj_curv)) (vla-put-patternscale hatch 1.0) (vla-put-patternangle hatch alpha) (vla-evaluate hatch) ) ) ) (*error* nil) (vla-EndUndoMark AcDoc) (prin1) )

Select at start of what you need, then shift select the end is fastest I know (you can actually go from end to the beginning as well).

somehow a document type object lives along your copied_objects so try this : (defun c:new_desktop_file_copy ( / acad_dbx object_list zero_point db) (defun make_color_21 (/ layers) (setq layers (vla-get-layers acad_dbx)) (vlax-map-collection (vla-get-blocks acad_dbx) '(lambda (block) (vlax-map-collection block '(lambda (object) (vla-put-color object 256) (if (/= 21 (vla-get-color (setq layer (vla-item layers (vla-get-layer object))))) (vla-put-color layer 21)))) ) ) ) (setq acad_dbx (vla-getinterfaceobject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." (substr (getvar 'acadver) 1 2)))) (prompt "\nPick objects to copy to a new file on the desktop...") (setq object_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))) (setq zero_point (getpoint "\nPick zero point for the copied entities: ")) (setq db (vla-get-database (vla-get-activedocument (vlax-get-acad-object)))) (foreach copied_object (setq odbx_objects_list (vlax-invoke db 'copyobjects object_list (vla-get-modelspace acad_dbx))) (if (vlax-method-applicable-p copied_object 'move) (vla-move copied_object (vlax-3d-point zero_point) (vlax-3d-point 0 0 0)) (princ (strcat "\nUnable to move object name : " (vla-get-name copied_object))) ) ) (make_color_21) (vla-saveas acad_dbx (princ (strcat (getenv "userprofile") "\\Desktop\\" (getstring "\nEnter file name: ") ".dwg"))) (vlax-release-object acad_dbx) (princ) )

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

Hi all, hoping someone can assist. I have an issue- when creating a 3D drawing in AutoCAD 2022, the shading on diagonal lines when in paper space appears jagged, see screen shot attached. This happens when printing to pdf/ plotting and when viewing on the screen. I am using the BASE command to import the 3D Model into a template. The shading looks fine in model space in all modes on diagonal lines. Is anyone able to please assist? Many thanks Alex

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.

(if (minusp (- botLength 6000)) (setq botLength 6000) )

If (- botLength 6000) is minus.... (if (= (minusp (- botlength 6000)) T) ;; verifies that a number is negative (setq botLength 0) ;; if it is, it will set to 0 (setq botLength (- botLength 6000)) ;; if it isn't, it will be substracted with "6000" ) ;;End If

Hi All, just wanted to thank everyone again for helping me so far in my lisp journey! As a token, I worked on a VS Code extension for AutoCAD snippets. This so it can allow users to type in quickly common functions the use all the time (e.g. search layer if dont exist create layer and so on). So far I have added the comment section. Happy to receive feedback and suggestions. Thank you https://marketplace.visualstudio.com/items?itemName=CivilTechSource.autocad-lisp-snippets

Another very useful is "Entmake functions.lsp", it has various entmake functions in it. Maybe make a word doc etc of your functions describing what they do. We had a "how to directory" with lots of help files. Was thinking about doing macros in Notepad++ run ents, run ss, ssl for layer, ssi for insert and so on. This is a common one. (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) ) Posted this before. Lisp files Apr 2024.docx

What are the computer specifications? What OS? Lines, LWPolylines, 2DPolylines or 3D Polylines I doubt there is a permanent fix except to repair the drawings that have the issue, though it could still be an issue with your computer graphics. If it's polylines, try exploding them to lines, then PEDIT them back to LWPolylines, also try an Audit on the affected drawings. You could post an example drawing that has the issue, maybe it will show on other's computers if it's a .dwg issue.

The OP is using AutoCAD LT 2026 and cannot use a .NET AFAIK. You are new so I removed your link to YouTube.

For me simplest and quickest is use a wipe out in the block, set to background then will auto obscure line underneath. Hopefully the result you want.

Something like this!? ; ***************************************************************************************************** ; Functions : PLBRJ ; Description : Breaking POLYLINE at blocks insertation points and joined into the one POLYLINE ; Author : Saxlle ; Date : January 19, 2026 ; ***************************************************************************************************** (prompt "\nTo run a LISP type: PLBRJ") (princ) (defun c:PLBRJ ( / ent joinList ptlist ss len spt ept i breakPoint) (setq ent (car (entsel "\nSelect the POLYLINE:")) joinList (list) ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))) ss (ssget "_F" ptlist (list (cons 0 "INSERT"))) len (sslength ss) spt (vlax-curve-getStartPoint (vlax-ename->vla-object ent)) ept (vlax-curve-getEndPoint (vlax-ename->vla-object ent)) joinList (append (list spt) joinList) i 0 ) (while (< i len) (setq breakPoint (cdr (assoc 10 (entget (ssname ss i))))) (command "_.BREAK" breakPoint "_f" breakPoint breakPoint) (setq joinList (append (list breakPoint) joinList)) (setq i (1+ i)) ) (setq joinList (reverse (append (list ept) joinList)) ss (ssget "_F" joinList (list (cons 0 "LWPOLYLINE"))) ) (command-s "_PEDIT" "m" ss "" "j" "" "") (prompt "\nThe POLYLINE was broken at blocks insert points and joined into the one POLYLINE!") (princ) )

Try this !? You can use POINT or Insert Point of block... Break_Poly@point.lsp

Sure @karfung, but I will leave you to do that (I'm writing from the phone). This is the hint, find it everywhere in the code: (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang) (cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")))) Find this part inside: Replace this part: (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")) With this: (cons 1 (strcat def_text (itoa lenSegment) " m")) and you will get the whole integer without the decimal part. I've heard the Durian, but never taste it. If I ever come to Malaysia, I will taste it . Best regards.

Well I was born on Mars (and my wife on Venus) and because of my job I currently live in NL

just look in autocad help for LUNITS & INSUNITS https://help.autodesk.com/view/ACD/2025/ENU/?guid=GUID-A58A87BB-482B-4042-A00A-EEF55A2B4FD8

I'v never taste the Durian .

You're welcome @karfung . I'm from Serbia. I have made changes to the code, please try it now (I hope I understand your requirements correctly). If it's not, try to change in sub-function "fix_value" the value from "500" to any other to get desired result. The fix function round up the real number into the nearest smallest integer number (for e.g. if you have a 3.70 m, and when you add 0.50 m, you will get 4.20 m, but using fix function which is an AutoLISP Core Function, you will get 4.0 m, also if you have 4.70 m, you will also get 4.0 m). Just an explanation to understand the logic. ; ************************************************************************************************** ; Functions : PLMTXT ; Sub-functions : ang_check_text, fix_value ; Description : Add predifined text with the length segment between two vertices on polyline ; Author : Saxlle ; Date : January 18, 2026 ; ************************************************************************************************** (prompt "\nTo run a LISP type: PLMTXT") (princ) (defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment) (setq old_osmode (getvar 'osmode) cur_layer (getvar 'clayer) old_nomutt (getvar 'nomutt) height (getreal "\nEnter the text height <2.50>: ") ;; text height def_text "BD/1:200/" ;; default text ) (if (= height nil) (setq height 2.50) ;; defaul text height, it can be changed ) (setvar 'osmode 0) (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be current (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current ) (setvar 'nomutt 1) (princ "\nSelect POLYLINES:") (setq ss (ssget (list (cons 0 "LWPOLYLINE"))) len (sslength ss) plist (list) i 0 ) (setvar 'nomutt old_nomutt) (while (< i len) (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i))))) (cond ;; the first cond ((= dxf_70 0) ;; LWPOLYLINE is OPEN (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i)))) dataList (list) n 0 k 1 ) (repeat (setq l (length plist)) (if (< k l) (setq pt1 (nth n plist) pt2 (nth k plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) n (1+ n) k (1+ k) ) ) ) (setq dataList (reverse dataList) n 0 ) (repeat (length dataList) (setq pt (car (nth n dataList)) ang (cadr (nth n dataList)) lenSegment (caddr (nth n dataList)) n (1+ n) ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang) (cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")))) ) ) ;; end first cond ;; the second cond ((= dxf_70 1) ;; LWPOLYLINE is CLOSED (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i)))) dataList (list) n 0 k 1 ) (repeat (setq l (length plist)) (if (< k l) (setq pt1 (nth n plist) pt2 (nth k plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) n (1+ n) k (1+ k) ) (setq n 0 k (1- k) pt1 (nth k plist) pt2 (nth n plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (/ (fix_value (distance pt1 pt2)) 1000) ;; 1000 mm equal to 1.0 m npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) ) ) ) (setq dataList (reverse dataList) n 0 ) (repeat (length dataList) (setq pt (car (nth n dataList)) ang (cadr (nth n dataList)) lenSegment (caddr (nth n dataList)) n (1+ n) ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang) (cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")))) ) ) ;; end second cond ) ;; end cond (setq i (1+ i)) ) (setvar 'osmode old_osmode) ;; restore osmode (setvar 'clayer cur_layer) ;; restore old layer (prompt "\nThe text was inserted!") (princ) ) ;; Sub-function to get a proper text angle (defun ang_check_text (ang) (cond ((<= ang 1.57) (setq ang ang) ) ((and (>= ang 1.57) (<= ang 3.14)) (setq ang (+ ang pi)) ) ((and (>= ang 3.14) (<= ang 4.71)) (setq ang (- ang pi)) ) ((>= ang 4.71) (setq ang ang) ) ) ) ;; Sub-function to round up number to the whole integer (defun fix_value (val) (if (not (minusp val)) (setq val (fix (+ val 500))) ;; 500 mm equal to 0.50 m (setq val (fix (- val 500))) ;; 500 mm equal to 0.50 m ) ) Best regards.

Please contact me when you reach here. I buy you durian.

chat made this, (defun orthogonalize-points (pts / dx-in dx-out dy-in dy-out i in-is-h new-x new-y out-is-h p0 p1 p2 result) ;; If fewer than 3 points, nothing to do (if (< (length pts) 3) pts (progn (setq result pts) ;; Iterate interior vertices (setq i 1) (while (< i (- (length pts) 1)) (setq p0 (nth (- i 1) result)) (setq p1 (nth i result)) (setq p2 (nth (+ i 1) result)) ;; Incoming vector p0 -> p1 (setq dx-in (- (car p1) (car p0))) (setq dy-in (- (cadr p1) (cadr p0))) ;; Outgoing vector p1 -> p2 (setq dx-out (- (car p2) (car p1))) (setq dy-out (- (cadr p2) (cadr p1))) ;; Dominant direction tests (setq in-is-h (>= (abs dx-in) (abs dy-in))) (setq out-is-h (>= (abs dx-out) (abs dy-out))) ;; Case 1: Proper corner (one horizontal, one vertical) (cond ((/= in-is-h out-is-h) (if in-is-h (progn ;; incoming horizontal, outgoing vertical (setq new-x (car p2)) (setq new-y (cadr p0)) ) (progn ;; incoming vertical, outgoing horizontal (setq new-x (car p0)) (setq new-y (cadr p2)) ) ) ) ;; Case 2: both horizontal (in-is-h (setq new-x (car p1)) (setq new-y (cadr p0)) ) ;; Case 3: both vertical (t (setq new-x (car p0)) (setq new-y (cadr p1)) ) ) ;; Replace interior point (setq result (subst (list new-x new-y) p1 result)) (setq i (1+ i)) ) result ) ) ) (defun c:ORTHO_PLINE ( / edata ent newpts p pl pts x) (setq ent (car (entsel "\nSelect a polyline: "))) (if (not ent) (progn (princ "\nNothing selected.") (exit) ) ) (setq edata (entget ent)) ;; Ensure LWPOLYLINE (if (/= (cdr (assoc 0 edata)) "LWPOLYLINE") (progn (princ "\nEntity is not a lightweight polyline.") (exit) ) ) ;; Extract vertices (group code 10) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))) ;; Orthogonalize (setq newpts (orthogonalize-points pts)) ;; Create new polyline (setq pl (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length newpts)) '(70 . 0) ) (mapcar '(lambda (p) (cons 10 p)) newpts) ) ) ) (if pl (princ "\nOrthogonal polyline created.") (princ "\nFailed to create polyline.") ) (princ) )

Hi @karfung, Try this and see if it fits to your needs: ; ********************************************************************************************** ; Functions : PLMTXT ; Description : Add predefined text with length segment between two vertices on polyline ; Author : Saxlle ; Date : January 18, 2026 ; ********************************************************************************************** (prompt "\nTo run a LISP type: PLMTXT") (princ) (defun c:PLMTXT ( / old_osmode cur_layer old_nomutt height def_text ss len i dxf_70 plist dataList n k pt1 pt2 midPt ang dist npt pt lenSegment) (setq old_osmode (getvar 'osmode) cur_layer (getvar 'clayer) old_nomutt (getvar 'nomutt) height (getreal "\nEnter the text height <2.50>: ") ;; text height def_text "BD/1:200/" ;; default text ) (if (= height nil) (setq height 2.50) ;; defaul text height, it can be changed ) (setvar 'osmode 0) (if (not (tblsearch "LAYER" "SNA-TXT")) ;; check does layer 'SNA-TXT' exist or not (command-s "-layer" "m" "SNA-TXT" "") ;; make the SNA-TXT layer and set to be the current (command-s "-layer" "s" "SNA-TXT" "") ;; set the SNA-TXT layer to be the current ) (setvar 'nomutt 1) (princ "\nSelect POLYLINES:") (setq ss (ssget (list (cons 0 "LWPOLYLINE"))) len (sslength ss) plist (list) i 0 ) (setvar 'nomutt old_nomutt) (while (< i len) (setq dxf_70 (cdr (assoc 70 (entget (ssname ss i))))) (cond ;; the first cond ((= dxf_70 0) ;; LWPOLYLINE is OPEN (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i)))) dataList (list) n 0 k 1 ) (repeat (setq l (length plist)) (if (< k l) (setq pt1 (nth n plist) pt2 (nth k plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (distance pt1 pt2) npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) n (1+ n) k (1+ k) ) ) ) (setq dataList (reverse dataList) n 0 ) (repeat (length dataList) (setq pt (car (nth n dataList)) ang (cadr (nth n dataList)) lenSegment (caddr (nth n dataList)) n (1+ n) ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang) (cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")))) ) ) ;; end first cond ;; the second cond ((= dxf_70 1) ;; LWPOLYLINE is CLOSED (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i)))) dataList (list) n 0 k 1 ) (repeat (setq l (length plist)) (if (< k l) (setq pt1 (nth n plist) pt2 (nth k plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (distance pt1 pt2) npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) n (1+ n) k (1+ k) ) (setq n 0 k (1- k) pt1 (nth k plist) pt2 (nth n plist) midPt (mapcar '* (mapcar '+ pt1 pt2) (list 0.5 0.5)) ang (ang_check_text (angle pt1 pt2)) dist (distance pt1 pt2) npt (polar midPt (+ (angle pt1 pt2) (/ pi 2)) height) dataList (append (list (list npt ang dist)) dataList) ) ) ) (setq dataList (reverse dataList) n 0 ) (repeat (length dataList) (setq pt (car (nth n dataList)) ang (cadr (nth n dataList)) lenSegment (caddr (nth n dataList)) n (1+ n) ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 11 pt) (cons 40 height) (cons 50 ang) (cons 71 5) (cons 1 (strcat def_text (rtos lenSegment 2 2) " m")))) ) ) ;; end second cond ) ;; end cond (setq i (1+ i)) ) (setvar 'osmode old_osmode) ;; restore osmode (setvar 'clayer cur_layer) ;; restore old layer (prompt "\nThe text was inserted!") (princ) ) ;; Sub-function to get a proper text angle (defun ang_check_text (ang) (cond ((<= ang 1.57) (setq ang ang) ) ((and (>= ang 1.57) (<= ang 3.14)) (setq ang (+ ang pi)) ) ((and (>= ang 3.14) (<= ang 4.71)) (setq ang (- ang pi)) ) ((>= ang 4.71) (setq ang ang) ) ) ) Also, see the short video example of how it works. PLMTXT.mp4 Best regards.

just feed this to the vanilla monster : (ScriptDwg fn (list "LUNITS" "2" "INSUNITS" "4" "LUPREC" "6" ".zoom" "extents")) this part is all pretty basic AutoCad

;;; https://www.cadtutor.net/forum/topic/98937-repair-lisp-to-create-superimpose-acad/ (defun c:new_desktop_file_copy ( / acad_dbx object_list zero_point db odbx_objects_list ss fn db actDocs doc) (vl-load-com) (setq acad_dbx (vla-getinterfaceobject (vlax-get-acad-object) (dbx_ver))) (defun make_color_21 ( / lays lay) (setq lays (vla-get-layers acad_dbx)) (vlax-map-collection (vla-get-blocks acad_dbx) '(lambda (b) (vlax-map-collection b '(lambda (o) (vla-put-color o 256) (if (/= 21 (vla-get-color (setq l (vla-item lays (vla-get-layer o))))) (vla-put-color l 21))))))) (prompt "\nPick objects to copy to a new file on the desktop...") (if (not (setq ss (ssget))) (princ "\nNothing was selected") (progn (setq object_list (ss->ol ss)) (setq zero_point (getpoint "\nPick zero point for the copied entities: ")) (setq db (vla-get-database (vla-get-activedocument (vlax-get-acad-object)))) (setq odbx_objects_list (vlax-invoke db 'copyobjects object_list (vla-get-modelspace acad_dbx))) (foreach copied_object odbx_objects_list (if (vlax-method-applicable-p copied_object 'move) (vla-move copied_object (vlax-3d-point zero_point) (vlax-3d-point 0 0 0)) (princ (strcat "\nUnable to move object name : " (vla-get-name copied_object))) ) ) (make_color_21) (if (eq (setq fn (getstring "\nEnter file name: ")) "") (princ (strcat "\nInvalid filename for new drawing : " (vl-princ-to-string fn))) (progn (setq fn (strcat (getenv "userprofile") "\\Desktop\\" fn ".dwg")) (vla-saveas acad_dbx fn) (vlax-release-object acad_dbx) (gc) (gc) (foreach obj object_list (vla-delete obj)) (command ".qsave") ;|lets go vanilla|;(ScriptDwg fn (list "LUNITS" "2" "LUPREC" "6" ".zoom" "extents")) ) ) ) ) (princ) ) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (defun ScriptDwg ( dwg-fn dwg-com / scr-fn scr-fp ) (if (= (getvar "SDI") 1) (setvar "SDI" 0)) (setq scr-fn (strcat (getvar 'MYDOCUMENTSPREFIX) "\\ScriptDwg.scr")) (cond ((or (not (= (type dwg-fn) 'STR)) (not (findfile dwg-fn))) (princ (strcat "\n*error* : unable to find drawing : " (vl-princ-to-string dwg-fn)))) ((not (setq scr-fp (open scr-fn "w"))) (princ "\n*error* : unable to create script for commands.")) ((not (vl-consp dwg-com)) (princ "\n*error* : no commands in script")) (t (write-line (_open_cmd dwg-fn) scr-fp) (mapcar '(lambda (s)(write-line s scr-fp)) dwg-com) (write-line (_close_cmd) scr-fp) ) ) (if scr-fp (progn (close scr-fp)(gc)(command "._script" scr-fn))) ) (defun _open_cmd ($fn) (strcat ".open\n\"" $fn "\"\n(while (= 1 (logand (getvar \"cmdactive\") 1))(command \"Yes\"))")) (defun _close_cmd () (eval "(if (= (getvar \"writestat\") 1)(command \".qsave\" \".close\"))")) (defun c:t1 nil (c:new_desktop_file_copy))

Here are the options for edit boxes: https://help.autodesk.com/view/ACD/2026/ENU/?guid=GUID-38A11AED-DDF5-4ACA-A8BB-1F7901D0AF50 I think if you change is_enabled from true to false it should do what you want, I can't remember jus now how to switch it from one to the other - might be a google thing

Thank @pkenewell, I will study it.

@Nikon FWIW, Here is an opportunity to show you how to store and retrieve system variables without all the extra variables in Lisp. Also - I've added undo marks to the command so everything stays together, and some stuff into the error handler. Nothing you did wrong; just showing another way to do the same thing with different techniques. ; MHATCH VVA /2006 + additions /2026 (defun c:UShatch_Doub_200 ( / d lst nab vars *error*) (defun *error* (msg) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*")) (princ (strcat "\nError: " msg "\n")) (princ "\nProgram Aborted.\n") ) ;; Cancel any open commands. (while (not (equal (getvar "cmdnames") ""))(command-s)) ;; If uh:varlist is found, reset all the system variables to original values stored. (if uh:varlist (mapcar '(lambda (var)(setvar (car var) (cdr var))) uh:varlist) ) (while (equal 8 (logand 8 (getvar "undoctl"))) (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object))) ) (princ) ) (vl-load-com) ;; Set an undo mark (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object)))) ;;Create an association list for the system variables and values to be set. (setq vars '(("cmdecho" . 0) ("osmode" . 0) ("hpname" . "_USER") ("hpang" . 0) ("hpdouble" . 1) ("hpspace" . 200) ("hpassoc" . 1))) ;; Gather the existing values for the system variables and add to association list "uh:varlist" (setq uh:varlist (mapcar '(lambda (var)(cons (car var) (getvar (car var)))) vars) ) ;; Set all the system variable to the values stored in "vars". (mapcar '(lambda (var)(setvar (car var) (cdr var))) vars) (if (and (setq nab (ssget "_:L")) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex nab)))) ) (foreach item lst (vl-catch-all-apply '(lambda ()(command "_.-bhatch" "_s" item "" "")) ) ) ) (mapcar (function (lambda (var)(setvar (car var) (cdr var)))) uh:varlist ) (vla-EndUndoMark d) (princ) ) (princ "Type in the command prompt UShatch_Doub_200")

If it all goes wrong then entmake it.... This link might help, with the code from code ding https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/td-p/8696712

@karfung, why not to do a Writeblock command, it allow to set units as need, and show zoom extend new block.dwg

@devitg Ok, try this. Now labels are fields. If you prefer simply Mtext, Ithink that you can change it (with previous code) mult-label_bearing.lsp

@SLW210 how to select all the code at code tags , like a short key ctrl+a or whatever

Maybe use (setvar 'hpname "User") in code, sets the pattern name.

@karfung see the new dwg new block.dwg

@karfung it seem to be you need to make a new.dwg , if so, you can use WRITEBLOCK acad command .

maybe first do an audit on this drawing

Does the LISP file load the Visual LISP ActiveX functions with (vl-load-com)? I don't see it in the code.

@oliver Try to reload the code at this answer

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