Leaderboard

@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

I have a dump LISP called TakeADump, maybe I need this to go along with it!

I relied on your pictures... ??? In your picture: I see for degrees: Deg/Min/Sec - Clockwise (on) - South 90d0' If not correct change ANGDIR, ANGBASE and AUNITS in: (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 2 2))

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

I don't really see the point of the dynamic mode in your function, especially if you want to snap to objects. This would seem to me to be sufficient and would resolve the osnap. (vl-load-com) (defun c:label_bearing ( / l_var AcDoc Space nw_style nw_obj pt1 pt alpha len_l m_pt val_txt) (setq l_var (mapcar 'getvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE"))) (initget "Bearing Degrees") (if (eq (getkword "\nResult in [Bearing/Degrees]?<Bearing>: ") "Degrees") (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 2 2)) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 0 0 4 3 2 2)) ) (setvar "TEXTSIZE" (* (getvar "VIEWSIZE") 0.015)) (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) (cond ((null (tblsearch "STYLE" "BEARING")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "BEARING")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 0.0 1.0 0.0) ) ) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point '(0.0 0.0 0.0)) 0.0 "" ) ) (initget 1) (setq pt1 (getpoint "\nPick base point: ")) (initget 1) (setq pt (getpoint pt1 "\nPick other point: ")) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt))) (setq alpha (angle pt1 pt) len_l (distance pt1 pt) m_pt (mapcar '* (mapcar '+ pt1 pt) '(0.5 0.5 0.5)) val_txt (vl-string-subst "%%d" "d" (strcat (angtos alpha) "\\P " (rtos len_l) " m")) ) (if (and (> alpha (* pi 0.5)) (<= alpha (* pi 1.5))) (setq alpha (+ alpha pi)) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'TextString 'Color) (list 5 (getvar "TEXTSIZE") 5 m_pt "BEARING" (getvar "CLAYER") alpha val_txt 2) ) (vla-endundomark AcDoc) (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var) (prin1) ) However, if you absolutely want the dynamic mode with the possibility of osnap, here is the redesigned function attached. ("osmode" must be defined beforehand, no possibility to force it when using the function) My management is succinct: only: "_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" For a more elaborate management see perhaps the LeeMac function label_Bearing-vertex.lsp

(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

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

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

Thanks, I've found that alternative an am using it for now. Functionally, I do prefer how the first addon works, but the resulting text issue is too painful to put up with because of that! I will submit a bug report to the developers.

to update entmod you need to get familiar with dxf codes. This simple lisps will dump to the command line. All entities follow a pattern. ;;----------------------------------------------------------------------------;; ;; Dump all DXF Group Data (defun C:DumpIt (/ ent) (while (setq ent (car (entsel "\nSelect Entity to Dump"))) (mapcar 'print (entget ent '( "*"))) ) (princ) ) ;;----------------------------------------------------------------------------;; ;; Dump All Visual Lisp Methods and Properties for Selected Entity (defun C:VDumpIt (/ ent) (while (setq ent (car (entsel "\nSelect Entity to Dump"))) (vlax-Dump-Object (vlax-Ename->Vla-Object ent) t) ) (princ) ) entsel will return an entity name and point of seleciton. use that to see which endpoint your closest to. and use that to update with entmod and entupd. ;;----------------------------------------------------------------------------;; ;; Extend line to new point. ;; https://www.cadtutor.net/forum/topic/98936-change-a-length-of-line-by-feeding-a-new-end-point-to-the-association-list/ (defun c:EXTLINE ( / sel ent pick line sp ep newpt) (if (setq sel (entsel "\nSelect line near the end to extend: ")) (progn (setq ent (car sel) pt (cadr sel) line (entget ent) ) (if (= (cdr (assoc 0 line)) "LINE") (progn (setq sp (cdr (assoc 10 line))) (setq ep (cdr (assoc 11 line))) (if (< (distance pt sp) (distance pt ep)) (setq newpt (getpoint ep "\nSpecify new endpoint: ") line (subst (cons 10 newpt) (assoc 10 line) line) ) (setq newpt (getpoint sp "\nSpecify new endpoint: ") line (subst (cons 11 newpt) (assoc 11 line) line) ) ) (entmod line) (entupd ent) ) (prompt "\nSelected entity is not a LINE.") ) ) ) (princ) )

My first comment is when you hard print the pdf you have to pick a paper size so why would you not just pick a paper size to start with ? I do not understand the Custom scale size needed. In the world you are normally metric or imperial paper sizes. You can easily with a lisp etc plot a standard sheet size in a layout that has a Viewport at the correct scale. I think that is the step your not understanding, many example code does exist. For me a couple of choices make multiple layouts at scale walking along a pline, make multiple rectangs in Model at a scale matching viewports and title blocks in layouts. In this image select a title block and scale pick on Model and correct layout is made. A rectang is drawn in the model showing the result so you can accept or erase and run again. You can move and rotate the rectang before making the matching layout.

You should use the Plot Stamp to add the plotted/printed date, the date on the drawing should always remain the same, each revision gets a date as well and also should remain the same throughout the history of the drawing.

Needs work, just an example from pyrx import Ap, Db, Ed, Ge, Gi import math print("command = yeehaw") class NavJig(Ed.DrawJig): def __init__(self, basepoint): Ed.DrawJig.__init__(self) self.ds = Ed.DragStatus.kNormal self.basepoint = basepoint self.curpoint = basepoint self.mt = Db.MText() self.mt.setDatabaseDefaults() self.mt.setAttachment(Db.MTextAttachmentPoint.kMiddleLeft) def get_vector_details(self, vector: Ge.Vector3d): v_length = vector.length() azimuth_rad = math.atan2(vector.x, vector.y) azimuth_deg = math.degrees(azimuth_rad) % 360 if 0 <= azimuth_deg <= 90: bearing = f"N {azimuth_deg:.2f} E" elif 90 < azimuth_deg <= 180: bearing = f"S {180 - azimuth_deg:.2f} E" elif 180 < azimuth_deg <= 270: bearing = f"S {azimuth_deg - 180:.2f} W" else: bearing = f"N {360 - azimuth_deg:.2f} W" return f"Length: {v_length:.4f}\\P" f"{azimuth_deg:.2f}%%d " f"{bearing}" def sampler(self): self.setUserInputControls(Ed.UserInputControls.kAccept3dCoordinates) self.ds, self.curpoint = self.acquirePoint() return self.ds def update(self): if self.ds == Ed.DragStatus.kNoChange: return False return True def worldDraw(self, wd: Gi.WorldDraw): if self.ds == Ed.DragStatus.kNoChange: return True try: geo = wd.geometry() v = self.curpoint - self.basepoint self.mt.setContents(self.get_vector_details(v)) self.mt.setLocation(self.basepoint + (v * 0.5)) self.mt.setDirection(v) geo.draw(self.mt) geo.polyline([self.basepoint, self.curpoint], Ge.Vector3d.kZAxis) return True except Exception as err: print(err) @Ap.Command() def yeehaw(): try: jig = NavJig(Ge.Point3d(0, 0, 0)) jig.setDispPrompt("\nPick point:\n") res = jig.drag() print("done", res) except Exception as err: print(err)

Have you looked into fields? When you edit a text object, you can type Ctrl-F to bring up the fields dialog. Pick a category, such as Date & Time, and pick the data you want to insert. To match your example, choose Date and a format. That field will be inserted into the text, like any other characters, but highlighted and with the corresponding data. There are many more pieces of data you can use. Once you put fields into your template, you may never have to change a title block again.

Another, could do a pop enter value in a dcl box etc, rather than command line. It works to specified length. (defun C:test2 ( / p1 p2 dist d) (initget 1) (setq p1 (getpoint "\npick point 1")) (initget 1) (setq p2 (getpoint p1 "\npick point 2")) (setq dist (distance p1 p2)) (setq d (getreal (strcat "\nLine length is " (rtos dist 2 2) " Enter new length "))) (if (= d nil) (princ) (setq dist d) ) (setq p2 (polar p1 (angle p1 p2) dist)) (command "_.line""_non" p1 "_non" p2 "") (princ) ) (c:test2)

Maybe it is possible to change the order of commands, at first "change", then "lengthen" ? (defun C:LineChLenDY ( / p1 p2 line1) (setq p1 (getpoint "Specify the first point: ")) (setq p2 (getpoint "Specify the second point: ")) (command "line" "non" p1 "non" p2 "") (setq line1 (entlast)) (command "change" line1 "" "P" "C" "1" "") (command "lengthen" "DYnamic") (princ) )

I don't think I have used lengthen in a LISP, not used the command for a while, but a quick look at your code "non"p2) - add a couple of spaces for readbility, but in that line you haven't specified the line to lengthen and you might need to end with "": (command "_lengthen" "DYnamic" "non" p2 (entlast) "")