Leaderboard

code: ;;; HEXENUM 1.5.1 | CN: markers beside unchanged MTEXT | CNC: relocated paragraphs. ;;; CNR: renumber existing markers; CN replaces recognized markers in the left column. ;;; Base block: side 0.1801, NUM height 0.10; insertion scale = MTEXT height / 0.10. ;;; Single line: centered. Wrapped paragraph: centered on its first two lines. ;;; Existing block definitions are never cleared/redefined. Compatible ones are reused. ;;; SOLID fill ACI 255. Uniform XYZ scale, non-explodable block. AutoCAD Windows. ;;; Single-column, non-annotative MTEXT on WCS XY; no fields or vertical writing. ;;; Complex mixed-height/stacked text needs visual verification of line placement. (vl-load-com) (defun R0:CN-Fail (msg) (setq cn-msg msg) (exit)) (defun R0:CN-Prefix (frames / result frame) (setq result "") (foreach frame (reverse frames) (setq result (strcat result "{" frame))) result) (defun R0:CN-Close (frames / result) (setq result "") (repeat (length frames) (setq result (strcat result "}"))) result) (defun R0:CN-Records (s / i n ch next token frames part visible result j brk start) (setq i 1 n (strlen s) frames (list "") part "{" visible nil) (while (<= i n) (setq start i ch (substr s i 1) next (substr s (1+ i) 1) brk nil) (cond ((or (= ch (chr 10)) (= ch (chr 13))) (setq brk T) (if (and (= ch (chr 13)) (= next (chr 10))) (setq i (1+ i))) (setq i (1+ i))) ((= ch "\\") (cond ((= next "P") (setq brk T i (+ i 2))) ((= next "N") (R0:CN-Fail "Column breaks found. Set the MTEXT to a single column.")) ((member next '("\\" "{" "}" "~")) (setq part (strcat part (substr s i 2)) i (+ i 2)) (if (/= next "~") (setq visible T))) ((member next '("A" "C" "c" "F" "f" "H" "Q" "T" "W" "p" "S")) (setq j (+ i 2)) (while (and (<= j n) (/= (substr s j 1) ";")) (setq j (1+ j))) (if (> j n) (R0:CN-Fail "Incomplete MTEXT formatting code.")) (setq token (substr s i (1+ (- j i))) part (strcat part token) i (1+ j)) (if (= next "S") (setq visible T) (setq frames (cons (strcat (car frames) token) (cdr frames))))) ((member next '("L" "l" "O" "o" "K" "k")) (setq token (substr s i 2) part (strcat part token) i (+ i 2) frames (cons (strcat (car frames) token) (cdr frames)))) ((and (= next "U") (= (substr s (+ i 2) 1) "+")) (setq part (strcat part (substr s i 7)) i (+ i 7) visible T)) (T (setq part (strcat part ch) i (1+ i) visible T)))) ((= ch "{") (setq frames (cons "" frames) part (strcat part ch) i (1+ i))) ((= ch "}") (if (null (cdr frames)) (R0:CN-Fail "Unbalanced formatting braces.")) (setq frames (cdr frames) part (strcat part ch) i (1+ i))) (T (setq part (strcat part ch) i (1+ i)) (if (not (member ch (list " " (chr 9)))) (setq visible T)))) (if brk (progn (if visible (setq result (cons (list (strcat part (R0:CN-Close frames)) (1- start) (R0:CN-Close frames)) result))) (setq part (R0:CN-Prefix frames) visible nil)))) (if (/= (length frames) 1) (R0:CN-Fail "Unbalanced formatting braces.")) (if visible (setq result (cons (list (strcat part (R0:CN-Close frames)) n (R0:CN-Close frames)) result))) (reverse result)) (defun R0:CN-Split (s) (mapcar 'car (R0:CN-Records s))) (defun R0:CN-Normalize (s) (while (vl-string-search (strcat (chr 13) (chr 10)) s) (setq s (vl-string-subst "\\P" (strcat (chr 13) (chr 10)) s))) (while (vl-string-search (chr 13) s) (setq s (vl-string-subst "\\P" (chr 13) s))) (while (vl-string-search (chr 10) s) (setq s (vl-string-subst "\\P" (chr 10) s))) s) (defun R0:CN-Register (obj) (setq cn-created (cons obj cn-created)) obj) (defun R0:CN-Box (obj / lo hi) (vla-Update obj) (vla-GetBoundingBox obj 'lo 'hi) (list (vlax-safearray->list lo) (vlax-safearray->list hi))) (defun R0:CN-Props (obj src) (vla-put-Layer obj (vla-get-Layer src)) (vla-put-TrueColor obj (vla-get-TrueColor src)) obj) (defun R0:CN-Text (space src content width h at attach / obj) (setq obj (R0:CN-Register (vla-AddMText space (vlax-3d-point at) width content))) (R0:CN-Props obj src) (vla-put-StyleName obj (vla-get-StyleName src)) (vla-put-Height obj h) (vla-put-Rotation obj 0.0) (vla-put-AttachmentPoint obj attach) (vla-put-InsertionPoint obj (vlax-3d-point at)) (vla-put-LineSpacingStyle obj (vla-get-LineSpacingStyle src)) (vla-put-LineSpacingFactor obj (vla-get-LineSpacingFactor src)) obj) (defun R0:CN-CenterY (obj box cy / mid) (setq mid (/ (+ (cadar box) (cadadr box)) 2.0)) (vla-Move obj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (list 0.0 (- cy mid) 0.0))) obj) (defun R0:CN-Discard (obj) (vla-Delete obj) (setq cn-created (vl-remove obj cn-created))) (defun R0:CN-Initial (/ s n valid) (while (not valid) (setq s (getstring (strcat "\n" cn-label " | Starting NUMBER <1>: "))) (if (= s "") (setq s "1")) (if (and (<= (strlen s) 9) (vl-every '(lambda (c) (and (>= c 48) (<= c 57))) (vl-string->list s))) (setq n (atoi s) valid T) (princ "\nEnter an integer from 0 to 999999999."))) n) (defun R0:CN-Annotative (ename / data) (setq data (assoc -3 (entget ename '("AcadAnnotative")))) (and data (member '(1070 . 1) (cdr (cadr data))))) (defun R0:CN-Select (/ pick en data layer done) (while (not done) (setvar "ERRNO" 0) (setq pick (entsel (strcat "\n" cn-label " | Select the MTEXT to number <Exit>: "))) (cond ((and (null pick) (= (getvar "ERRNO") 7)) (princ "\nNothing selected. Click the MTEXT again; Enter exits.")) ((null pick) (setq done T en nil)) (T (setq en (car pick) data (entget en) layer (if data (tblsearch "LAYER" (cdr (assoc 8 data))))) (cond ((null data) (princ "\nObject no longer available. Select another MTEXT.")) ((/= (cdr (assoc 0 data)) "MTEXT") (princ "\nSelect an MTEXT object, not single-line text or a block.")) ((null layer) (princ "\nCannot read the object layer. Select another MTEXT.")) ((/= 0 (logand 5 (cdr (assoc 70 layer)))) (princ "\nThe MTEXT layer is locked or frozen. Select another MTEXT or press Enter to exit.")) ((minusp (cdr (assoc 62 layer))) (princ "\nThe layer is turned off.")) (T (setq done T)))))) en) (defun R0:CN-Scale (height) (/ height 0.10)) (defun R0:CN-Side (height) (* 0.1801 (R0:CN-Scale height))) (defun R0:CN-Height (box) (- (cadadr box) (cadar box))) ;;; Safe prefix boundaries: never cut a formatting code, Unicode escape or stack. (defun R0:CN-Cuts (s / i n ch nx j depth visible cuts) (setq i 1 n (strlen s) depth 0) (while (<= i n) (setq ch (substr s i 1) nx (substr s (1+ i) 1) visible nil) (cond ((= ch "{") (setq depth (1+ depth) i (1+ i))) ((= ch "}") (setq depth (1- depth) i (1+ i))) ((= ch "\\") (cond ((member nx '("A" "C" "c" "F" "f" "H" "Q" "T" "W" "p" "S")) (setq j (+ i 2)) (while (and (<= j n) (/= (substr s j 1) ";")) (setq j (1+ j))) (if (> j n) (R0:CN-Fail "Incomplete paragraph formatting.")) (setq i (1+ j) visible (= nx "S"))) ((and (= nx "U") (= (substr s (+ i 2) 1) "+")) (setq i (+ i 7) visible T)) ((member nx '("L" "l" "O" "o" "K" "k")) (setq i (+ i 2))) (T (setq i (+ i 2) visible T)))) (T (setq i (1+ i) visible (not (member ch (list " " (chr 9))))))) (if visible (setq cuts (cons (list (1- i) depth) cuts)))) (reverse cuts)) (defun R0:CN-PrefixAt (s cut / out) (setq out (substr s 1 (car cut))) (repeat (cadr cut) (setq out (strcat out "}"))) out) ;;; Measure the first rendered wrap using balanced prefixes of the actual paragraph. ;;; Uses the source font, width and line spacing; no hard-coded interline distance. (defun R0:CN-AnchorOffset (probe paragraph fullHeight / cuts firstHeight threshold low high mid sample twoHeight) (setq cuts (R0:CN-Cuts paragraph)) (if (not cuts) (R0:CN-Fail "Cannot measure an empty paragraph.")) (vla-put-TextString probe (R0:CN-PrefixAt paragraph (car cuts))) (setq firstHeight (R0:CN-Height (R0:CN-Box probe)) threshold (+ firstHeight (* 0.20 firstHeight))) (if (<= firstHeight 1e-12) (R0:CN-Fail "Cannot measure the first line of text.")) (if (<= fullHeight threshold) (/ fullHeight 2.0) (progn (setq low 0 high (1- (length cuts))) (while (< low high) (setq mid (fix (/ (+ low high) 2))) (vla-put-TextString probe (R0:CN-PrefixAt paragraph (nth mid cuts))) (setq sample (R0:CN-Height (R0:CN-Box probe))) (if (> sample threshold) (setq high mid) (setq low (1+ mid)))) (vla-put-TextString probe (R0:CN-PrefixAt paragraph (nth low cuts))) (setq twoHeight (R0:CN-Height (R0:CN-Box probe))) (/ (min fullHeight twoHeight) 2.0)))) (defun R0:CN-BlockCompatible (blk / obj typ ok pl att hatch coords expected k a data) (setq ok (and (= (vla-get-Count blk) 3) (= (vla-get-Units blk) (getvar "INSUNITS")) (= (vla-get-BlockScaling blk) 1) (= (vla-get-Explodable blk) :vlax-false) (= (vla-get-IsXRef blk) :vlax-false) (equal (vlax-safearray->list (vlax-variant-value (vla-get-Origin blk))) '(0.0 0.0 0.0) 1e-9))) (vlax-for obj blk (setq typ (vla-get-ObjectName obj)) (cond ((= typ "AcDbPolyline") (if pl (setq ok nil)) (setq pl obj)) ((= typ "AcDbAttributeDefinition") (if att (setq ok nil)) (setq att obj)) ((= typ "AcDbHatch") (if hatch (setq ok nil)) (setq hatch obj)) (T (setq ok nil)))) (if (and ok pl att hatch) (progn (setq coords (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates pl))) k 5) (repeat 6 (setq a (* pi (/ k 3.0)) expected (cons (* 0.1801 (cos a)) (cons (* 0.1801 (sin a)) expected)) k (1- k))) (setq ok (and (equal coords expected 1e-8) (= (vla-get-Closed pl) :vlax-true) (equal (vla-get-Elevation pl) 0.0 1e-9) (equal (vlax-safearray->list (vlax-variant-value (vla-get-Normal pl))) '(0.0 0.0 1.0) 1e-9) (= (strcase (vla-get-TagString att)) "NUM") (= (vla-get-Constant att) :vlax-false) (= (vla-get-Invisible att) :vlax-false) (equal (vla-get-Height att) 0.10 1e-8) (= (vla-get-Alignment att) 10) (equal (vlax-safearray->list (vlax-variant-value (vla-get-TextAlignmentPoint att))) '(0.0 0.0 0.0) 1e-8) (= (strcase (vla-get-PatternName hatch)) "SOLID") (= (vla-get-Color hatch) 255))) (setq k 0) (repeat 6 (if (not (equal (vla-GetBulge pl k) 0.0 1e-10)) (setq ok nil)) (setq k (1+ k))) (if (not (equal (vla-get-Area hatch) (* 1.5 (sqrt 3.0) 0.1801 0.1801) 1e-8)) (setq ok nil)) (if (not (equal (R0:CN-Box hatch) (list (list -0.1801 (- (* 0.1801 (/ (sqrt 3.0) 2.0))) 0.0) (list 0.1801 (* 0.1801 (/ (sqrt 3.0) 2.0)) 0.0)) 1e-8)) (setq ok nil))) (setq ok nil)) ok) (defun R0:CN-NewBlock (doc name / blk k a coords arr pl hatch loop att dict order) (setq blk (vla-Add (vla-get-Blocks doc) (vlax-3d-point '(0.0 0.0 0.0)) name) cn-newblock blk k 5) (vla-put-Units blk (getvar "INSUNITS")) (repeat 6 (setq a (* pi (/ k 3.0)) coords (cons (* 0.1801 (cos a)) (cons (* 0.1801 (sin a)) coords)) k (1- k))) (setq arr (vlax-make-safearray vlax-vbDouble '(0 . 11))) (vlax-safearray-fill arr coords) (setq pl (vla-AddLightWeightPolyline blk arr)) (vla-put-Closed pl :vlax-true) (vla-put-Layer pl "0") (vla-put-Color pl 0) (vla-put-ConstantWidth pl 0.0) (vla-put-Lineweight pl 0) (setq hatch (vla-AddHatch blk 0 "SOLID" :vlax-false 0) loop (vlax-make-safearray vlax-vbObject '(0 . 0))) (vlax-safearray-put-element loop 0 pl) (vla-AppendOuterLoop hatch loop) (vla-put-Layer hatch "0") (vla-put-Color hatch 255) (vla-put-EntityTransparency hatch "0") (vla-Evaluate hatch) (setq att (vla-AddAttribute blk 0.10 0 "Number" (vlax-3d-point '(0.0 0.0 0.0)) "NUM" "1")) (vla-put-Layer att "0") (vla-put-Color att 0) (vla-put-StyleName att "Standard") (vla-put-Height att 0.10) (vla-put-Alignment att 10) (vla-put-TextAlignmentPoint att (vlax-3d-point '(0.0 0.0 0.0))) (vla-put-BlockScaling blk 1) (vla-put-Explodable blk :vlax-false) (setq dict (vla-GetExtensionDictionary blk) order (vl-catch-all-apply 'vla-GetObject (list dict "ACAD_SORTENTS"))) (if (vl-catch-all-error-p order) (setq order (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable"))) (vlax-safearray-put-element loop 0 hatch) (vla-MoveToBottom order loop) name) (defun R0:CN-BlockDef (doc / name i blocks blk compatible ready) (setq name "CN_HEX" i 0 blocks (vla-get-Blocks doc)) (while (not ready) (if (not (tblsearch "BLOCK" name)) (progn (R0:CN-NewBlock doc name) (setq ready T)) (progn (setq blk (vla-Item blocks name) compatible (vl-catch-all-apply 'R0:CN-BlockCompatible (list blk))) (if (and (not (vl-catch-all-error-p compatible)) compatible) (setq ready T) (progn (setq i (1+ i) name (strcat "CN_HEX_14_" (itoa i))) (if (> i 1000) (R0:CN-Fail "Too many conflicting marker block names."))))))) (if (> i 0) (princ (strcat "\nExisting block definitions preserved. Using " name "."))) name) (defun R0:CN-Marker (space src center number / obj scale side atts att found box w h factor) (setq scale (R0:CN-Scale (vla-get-Height src)) side (R0:CN-Side (vla-get-Height src)) obj (R0:CN-Register (vla-InsertBlock space (vlax-3d-point center) cn-blockname scale scale scale 0.0))) (R0:CN-Props obj src) (setq atts (vlax-safearray->list (vlax-variant-value (vla-GetAttributes obj)))) (foreach att atts (if (= (strcase (vla-get-TagString att)) "NUM") (progn (setq found T) (vla-put-TextString att (itoa number)) (vla-put-StyleName att (vla-get-StyleName src)) (vla-put-Height att (vla-get-Height src)) (vla-put-Alignment att 10) (vla-put-TextAlignmentPoint att (vlax-3d-point center)) (setq box (R0:CN-Box att) w (- (caadr box) (caar box)) h (R0:CN-Height box) factor (min 1.0 (/ (* side 1.45) (max w 1e-12)) (/ (* side 1.2) (max h 1e-12)))) (if (< factor 1.0) (vla-put-Height att (* (vla-get-Height att) factor))) (vla-put-TextAlignmentPoint att (vlax-3d-point center)) (vla-Update att) (if (/= (vla-get-TextString att) (itoa number)) (R0:CN-Fail "Could not verify the NUM attribute."))))) (if (not found) (R0:CN-Fail "Marker has no editable NUM attribute.")) obj) (defun R0:CN-InPlace (space src content records height width point initial / probe single lineProbe box top left side rec prefix total partHeight offset cy center number previous overlaps) (setq probe (R0:CN-Text space src content width height point (vla-get-AttachmentPoint src))) (vla-put-Visible probe :vlax-false) (setq box (R0:CN-Box probe) top (cadadr box) left (caar box) side (R0:CN-Side height) number initial overlaps 0) (vla-put-AttachmentPoint probe 1) (vla-put-InsertionPoint probe (vlax-3d-point point)) (setq single (R0:CN-Text space src "M" width height point 1) lineProbe (R0:CN-Text space src "M" width height point 1)) (vla-put-Visible single :vlax-false) (vla-put-Visible lineProbe :vlax-false) (foreach rec records (setq prefix (strcat "{" (substr content 1 (cadr rec)) (caddr rec))) (vla-put-TextString probe prefix) (setq total (R0:CN-Height (R0:CN-Box probe))) (vla-put-TextString single (car rec)) (setq partHeight (R0:CN-Height (R0:CN-Box single)) offset (R0:CN-AnchorOffset lineProbe (car rec) partHeight) cy (- (+ (- top total) partHeight) offset) center (list (- left side (* 0.7 height)) cy (caddr point))) (if (and previous (< (abs (- previous cy)) (* (sqrt 3.0) side))) (setq overlaps (1+ overlaps))) (R0:CN-Marker space src center number) (setq previous cy number (1+ number))) (R0:CN-Discard lineProbe) (R0:CN-Discard single) (R0:CN-Discard probe) (if (> overlaps 0) (princ (strcat "\n[!] " (itoa overlaps) " adjacent marker pairs may overlap." " Increase paragraph spacing or use CNC; original MTEXT was not moved."))) number) (defun R0:CN-Relocate (space src parts height width point initial / number side apothem para obj box realHeight offset upper lower cy bottom probe delta) (setq number initial side (R0:CN-Side height) apothem (* side (/ (sqrt 3.0) 2.0)) probe (R0:CN-Text space src "M" width height point 1)) (vla-put-Visible probe :vlax-false) (foreach para parts (setq obj (R0:CN-Text space src para width height (list (+ (car point) side (* 0.7 height)) (cadr point) (caddr point)) 1) box (R0:CN-Box obj) realHeight (R0:CN-Height box) offset (R0:CN-AnchorOffset probe para realHeight) upper (max apothem offset) lower (max apothem (- realHeight offset)) cy (if bottom (- bottom (* 0.8 height) upper) (cadr point)) delta (- (+ cy offset) (cadadr box))) (vla-Move obj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (list 0.0 delta 0.0))) (R0:CN-Marker space src (list (car point) cy (caddr point)) number) (setq bottom (- cy lower) number (1+ number))) (R0:CN-Discard probe) number) (defun R0:CN-Cleanup (rollback / obj result) (if rollback (progn (foreach obj cn-saved (vl-catch-all-apply 'vla-put-TextString (list (car obj) (cadr obj))) (vl-catch-all-apply 'vla-Update (list (car obj)))) (foreach obj cn-erased (if (not (entget obj)) (if (not (entdel obj)) (princ "\n[!] Could not restore an old marker; use UNDO.")))))) (if (and rollback cn-retiring cn-source (null (entget cn-source))) (if (not (entdel cn-source)) (princ "\n[!] Check whether the original MTEXT was restored."))) (if rollback (progn (foreach obj cn-created (if (not (vlax-erased-p obj)) (progn (setq result (vl-catch-all-apply 'vla-Delete (list obj))) (if (vl-catch-all-error-p result) (princ "\n[!] Could not remove an output object; use UNDO to review this run."))))) (if cn-newblock (vl-catch-all-apply 'vla-Delete (list cn-newblock))))) (if cn-highlight (vl-catch-all-apply 'redraw (list cn-source 4))) (if cn-undo (vl-catch-all-apply 'vla-EndUndoMark (list cn-doc))) (foreach obj cn-vars (vl-catch-all-apply 'setvar (list (car obj) (cdr obj)))) (princ)) (defun R0:CN-Run (relocate / *error* cn-msg cn-created cn-source cn-highlight cn-doc cn-undo cn-vars cn-retiring cn-newblock cn-blockname cn-label cn-erased cn-saved oldmarkers src data content records parts height width rotation normal style initial option point space number obj) (defun *error* (msg) (R0:CN-Cleanup T) (cond (cn-msg (princ (strcat "\n[!] " cn-label ": " cn-msg))) ((and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))) (princ (strcat "\n[!] " cn-label ": " msg))) (T (princ (strcat "\n" cn-label " canceled. Original preserved.")))) (princ)) (setq cn-label (if relocate "CNC" "CN") cn-doc (vla-get-ActiveDocument (vlax-get-acad-object)) cn-vars (list (cons "DYNMODE" (getvar "DYNMODE")) (cons "DYNPROMPT" (getvar "DYNPROMPT")) (cons "ERRNO" (getvar "ERRNO")))) (setvar "DYNMODE" 3) (setvar "DYNPROMPT" 1) (if (setq cn-source (R0:CN-Select)) (progn (setq src (vlax-ename->vla-object cn-source) data (entget cn-source) content (R0:CN-Normalize (vla-get-TextString src)) height (vla-get-Height src) width (vla-get-Width src) rotation (vla-get-Rotation src) normal (cdr (assoc 210 data)) style (tblobjname "STYLE" (vla-get-StyleName src))) (if (and normal (not (equal normal '(0.0 0.0 1.0) 1e-8))) (R0:CN-Fail "This version requires text on a plane parallel to WCS XY.")) (if (vl-string-search "%<" content) (R0:CN-Fail "MTEXT fields are not supported.")) (if (and (assoc 75 data) (/= 0 (cdr (assoc 75 data)))) (R0:CN-Fail "Disable MTEXT columns before numbering.")) (if (or (= (cdr (assoc 72 data)) 3) (/= 0 (logand 4 (cdr (assoc 70 (tblsearch "STYLE" (vla-get-StyleName src))))))) (R0:CN-Fail "Vertical text is not supported.")) (if (or (R0:CN-Annotative cn-source) (and style (R0:CN-Annotative style))) (R0:CN-Fail "Use non-annotative MTEXT and a non-annotative style.")) (if (<= height 0.0) (R0:CN-Fail "Invalid text height.")) (setq records (R0:CN-Records content) parts (mapcar 'car records)) (if (not parts) (R0:CN-Fail "No non-empty paragraphs found.")) (if (> (length parts) 10000) (R0:CN-Fail "The limit is 10000 paragraphs per run.")) (redraw cn-source 3) (setq cn-highlight T) (princ (strcat "\n" (itoa (length parts)) " paragraphs | Hexagon side: " (rtos (R0:CN-Side height) 2 5) " | Scale: " (rtos (R0:CN-Scale height) 2 4))) (if (or (vl-string-search "\\H" content) (vl-string-search "\\S" content)) (princ "\n[!] Height overrides/stacked text found; visually check the first-two-line alignment.")) (setq initial (R0:CN-Initial)) (if (> (+ initial (length parts) -1) 999999999) (R0:CN-Fail "The final number would exceed 999999999.")) (if relocate (progn (initget "Keep Delete") (setq option (getkword "\nCNC | ORIGINAL [Keep/Delete] <Keep>: ")) (initget 1) (setq point (trans (getpoint (strcat "\nCNC | Center of FIRST hexagon (" (itoa initial) "): ")) 1 0))) (setq option "Keep" point (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint src))))) (setq space (vlax-ename->vla-object (cdr (assoc 330 (reverse data))))) (if (and (= 1 (logand 1 (getvar "UNDOCTL"))) (= 0 (logand 8 (getvar "UNDOCTL")))) (progn (vla-StartUndoMark cn-doc) (setq cn-undo T))) (if (not relocate) (progn (setq oldmarkers (R0:CN-FindMarkers src)) (foreach obj oldmarkers (if (not (R0:CN-Editable obj)) (R0:CN-Fail (strcat "Existing marker layer is locked, frozen or off: " (cdr (assoc 8 (entget obj))) ". No markers replaced.")))) (if oldmarkers (princ (strcat "\nCN | Replacing " (itoa (length oldmarkers)) " existing markers beside this MTEXT."))))) (setq cn-blockname (R0:CN-BlockDef cn-doc)) (setq number (if relocate (R0:CN-Relocate space src parts height width point initial) (R0:CN-InPlace space src content records height width point initial))) (foreach obj cn-created (if (not (equal rotation 0.0 1e-12)) (vla-Rotate obj (vlax-3d-point point) rotation)) (vla-Update obj) (if (not (entget (vlax-vla-object->ename obj))) (R0:CN-Fail "Could not verify the output."))) (if (/= (length cn-created) (* (if relocate 2 1) (length parts))) (R0:CN-Fail "The output is incomplete.")) (R0:CN-RetireMarkers oldmarkers) (vla-Regen cn-doc 0) (redraw cn-source 4) (setq cn-highlight nil) (if (= option "Delete") (progn (setq cn-retiring T) (if (not (entdel cn-source)) (R0:CN-Fail "Could not delete the original.")))) (setq cn-created nil cn-retiring nil cn-newblock nil cn-erased nil) (R0:CN-Cleanup nil) (princ (strcat "\n[OK] " (itoa (length parts)) " paragraphs | Numbers " (itoa initial) " to " (itoa (1- number)) " | " (if relocate (strcat "Original " (if (= option "Delete") "deleted." "preserved.")) "Original MTEXT unchanged.")))) (R0:CN-Cleanup nil)) (princ)) ;;; Recognize only this routine's marker families and an editable NUM attribute. (defun R0:CN-NumAttribute (obj / att found) (if (= (vla-get-HasAttributes obj) :vlax-true) (foreach att (vlax-safearray->list (vlax-variant-value (vla-GetAttributes obj))) (if (= (strcase (vla-get-TagString att)) "NUM") (setq found att)))) found) (defun R0:CN-IsMarker (en / obj name) (if (= (cdr (assoc 0 (entget en))) "INSERT") (progn (setq obj (vlax-ename->vla-object en) name (strcase (if (vlax-property-available-p obj 'EffectiveName) (vla-get-EffectiveName obj) (vla-get-Name obj)))) (and (or (= name "IR_HEX") (= name "CN_HEX") (wcmatch name "CN_HEX_14_#,CN_HEX_14_##,CN_HEX_14_###,CN_HEX_14_####")) (R0:CN-NumAttribute obj))))) (defun R0:CN-Owner (en) (cdr (assoc 330 (reverse (entget en))))) (defun R0:CN-Editable (en / layer) (setq layer (tblsearch "LAYER" (cdr (assoc 8 (entget en))))) (and layer (= 0 (logand 5 (cdr (assoc 70 layer)))) (> (cdr (assoc 62 layer)) 0))) (defun R0:CN-Unrotate (p origin angle / x y c s) (setq x (- (car p) (car origin)) y (- (cadr p) (cadr origin)) c (cos angle) s (sin angle)) (list (+ (car origin) (* x c) (* y s)) (+ (cadr origin) (- (* y c) (* x s))) (caddr p))) (defun R0:CN-InColumn (p box height) (and (>= (car p) (- (caar box) (* 4.0 height))) (<= (car p) (- (caar box) (* 0.5 height))) (>= (cadr p) (- (cadar box) (* 0.10 height))) (<= (cadr p) (+ (cadadr box) (* 0.10 height))) (equal (caddr p) (caddar box) (max 1e-8 (* height 1e-6))))) ;;; Legacy markers have no ownership metadata: use a narrow, text-local left column. ;;; Never search inside definitions or across model/paper-space owners. (defun R0:CN-FindMarkers (src / en owner space probe box point rotation height ss i candidate obj p found) (setq en (vlax-vla-object->ename src) owner (R0:CN-Owner en) space (vlax-ename->vla-object owner) point (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint src))) rotation (vla-get-Rotation src) height (vla-get-Height src)) (if (not (R0:CN-Editable en)) (R0:CN-Fail "The selected text layer is locked, frozen or off.")) (if (and (assoc 210 (entget en)) (not (equal (cdr (assoc 210 (entget en))) '(0.0 0.0 1.0) 1e-8))) (R0:CN-Fail "Marker detection requires MTEXT parallel to WCS XY.")) (setq probe (R0:CN-Text space src (vla-get-TextString src) (vla-get-Width src) height point (vla-get-AttachmentPoint src))) (vla-put-Visible probe :vlax-false) (setq box (R0:CN-Box probe)) (R0:CN-Discard probe) (setq ss (ssget "_X" '((0 . "INSERT"))) i 0) (if ss (repeat (sslength ss) (setq candidate (ssname ss i) i (1+ i)) (if (and (equal owner (R0:CN-Owner candidate)) (R0:CN-IsMarker candidate)) (progn (setq obj (vlax-ename->vla-object candidate) p (R0:CN-Unrotate (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))) point rotation)) (if (R0:CN-InColumn p box height) (setq found (cons candidate found))))))) found) ;;; Defer removal until new output is verified; record every erased reference for rollback. (defun R0:CN-RetireMarkers (items / en) (foreach en items (if (not (R0:CN-Editable en)) (R0:CN-Fail (strcat "Existing marker layer is locked, frozen or off: " (cdr (assoc 8 (entget en))) ". No markers replaced.")))) (foreach en items (setq cn-erased (cons en cn-erased)) (if (not (entdel en)) (R0:CN-Fail "Could not replace an existing marker.")))) (defun R0:CN-SortMarkers (items angle / rows en obj p index) (setq index 0) (foreach en items (setq obj (vlax-ename->vla-object en) p (R0:CN-Unrotate (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))) '(0.0 0.0 0.0) angle) rows (cons (list en (car p) (cadr p) index) rows) index (1+ index))) (mapcar 'car (vl-sort rows '(lambda (a b) (cond ((/= (caddr a) (caddr b)) (> (caddr a) (caddr b))) ((/= (cadr a) (cadr b)) (< (cadr a) (cadr b))) (T (< (cadddr a) (cadddr b)))))))) (defun R0:CN-Renumber (/ *error* cn-msg cn-created cn-source cn-highlight cn-doc cn-undo cn-vars cn-retiring cn-newblock cn-erased cn-saved cn-label ss i en obj items found candidate angle initial number att) (defun *error* (msg) (R0:CN-Cleanup T) (cond (cn-msg (princ (strcat "\n[!] CNR: " cn-msg))) ((and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))) (princ (strcat "\n[!] CNR: " msg))) (T (princ "\nCNR canceled. Previous numbers restored."))) (princ)) (setq cn-label "CNR" cn-doc (vla-get-ActiveDocument (vlax-get-acad-object)) cn-vars (list (cons "DYNMODE" (getvar "DYNMODE")) (cons "DYNPROMPT" (getvar "DYNPROMPT")) (cons "ERRNO" (getvar "ERRNO")))) (setvar "DYNMODE" 3) (setvar "DYNPROMPT" 1) (princ "\nCNR | Select MTEXT to detect its markers, or select the hexagon blocks: ") (setq ss (ssget '((0 . "MTEXT,INSERT")))) (if ss (progn (if (and (= 1 (logand 1 (getvar "UNDOCTL"))) (= 0 (logand 8 (getvar "UNDOCTL")))) (progn (vla-StartUndoMark cn-doc) (setq cn-undo T))) (setq i 0) (repeat (sslength ss) (setq en (ssname ss i) i (1+ i) obj (vlax-ename->vla-object en)) (setq found (cond ((= (vla-get-ObjectName obj) "AcDbMText") (R0:CN-FindMarkers obj)) ((R0:CN-IsMarker en) (list en)))) (foreach candidate found (if (not (member candidate items)) (setq items (cons candidate items))))) (if (not items) (R0:CN-Fail "No recognized hexagons found. Select the marker blocks directly.")) (if (> (length items) 10000) (R0:CN-Fail "Select at most 10000 markers.")) (setq angle (vla-get-Rotation (vlax-ename->vla-object (car items)))) (foreach en items (setq obj (vlax-ename->vla-object en)) (if (not (R0:CN-Editable en)) (R0:CN-Fail (strcat "Marker layer is locked, frozen or off: " (cdr (assoc 8 (entget en))) ". No numbers changed."))) (if (not (equal (sin (/ (- (vla-get-Rotation obj) angle) 2.0)) 0.0 1e-6)) (R0:CN-Fail "Select one text orientation at a time."))) (setq items (R0:CN-SortMarkers items angle)) (princ (strcat "\nCNR | " (itoa (length items)) " markers | Top to bottom in text orientation.")) (setq initial (R0:CN-Initial) number initial) (if (> (+ initial (length items) -1) 999999999) (R0:CN-Fail "Final number exceeds 999999999.")) (foreach en items (setq att (R0:CN-NumAttribute (vlax-ename->vla-object en))) (setq cn-saved (cons (list att (vla-get-TextString att)) cn-saved)) (vla-put-TextString att (itoa number)) (vla-Update att) (if (/= (vla-get-TextString att) (itoa number)) (R0:CN-Fail "Could not verify a new number.")) (setq number (1+ number))) (vla-Regen cn-doc 0) (setq cn-saved nil) (princ (strcat "\n[OK] CNR | " (itoa (length items)) " markers | " (itoa initial) " to " (itoa (1- number)) " | Geometry and positions unchanged.")))) (R0:CN-Cleanup nil) (princ)) (defun c:CNR () (R0:CN-Renumber)) (defun c:CN () (R0:CN-Run nil)) (defun c:CNC () (R0:CN-Run T)) (princ "\nHEXENUM 1.5.1 | CN: number/replace | CNC: create elsewhere | CNR: renumber.") (princ) Hi @dber I’ve got the final version fully polished and working perfectly. Here is the updated code and a quick GIF showing it in action. All your requests are covered: Commands: Renamed to CN and CNC. Block Scaling & Style: The CN_HEX block now uses uniform scaling, matches your MTEXT text style and height perfectly, and won't distort or explode. Hexagon Positioning: Single and double lines are perfectly centered. For 3+ lines, the hexagon is now precisely aligned between the 1st and 2nd lines. Bonus features included: CNR Command: Use this to easily renumber existing hexagons if you ever need to change the starting number. Smart Replacement: If you run CN again, it automatically replaces the old markers without creating duplicates. Auto-Realignment: If you change the MTEXT width grip, just run CN again and it realigns everything instantly. Give it a try and let me know how it works for your project! Best, Romero

Yes, I already mentioned that. Easy enough to place them manually, but replacing the dimrad/dimdia marks are not as easy as I was hoping, or I am going about it wrong. I set the Layer I create Centermark to Bylayer and the CENTERMARK layer on that with CENTERLTYPE to ByLayer and that issue is fixed. CENTERLTYPEFILE, I think I have a way to detect Metric and change that to acadiso.lin, so that's solved. I have to get it to find the object, since CENTERMARK works by getting the Circle or Arc object. I am thinking about just turning off the Dimrad/Dimdia Mark/Line and placing a CENTERMARK on all circles and arcs in current space or entire drawing, though that would have concentric objects with more than one, so I have to still sort for the largest for correct size. I have the original using lines working better and properly sizing automatically now, but still tweaking, I am leaving the crosshair lines option for older AutoCAD and CAD's that don't have CENTERMARK option.

1. too many lisp to remember what each one dose. 2. how to bring all of those lisp's up to a new computer. I have 189 lisps at the moment. well, 1. I have a simple excel table of all my lisps, the file name, the command and what they do. every time I add a lisp I add it to the file to keep track and to know what they do if I didn't add description in lisp file at the top as a remark. 2. to load them I don't use appload for each one. I use lisp file with autoload line for each lisp and use appload only for that file,one line only in the appload command. 3. upgrade to a new computer/laptop? copy all the lisp files to the new computer including the autoload lisp, run appload to load that startup lisp, check the "AUTOLOAD" check box and you are done, again - one lisp to load all the others. and if you had dependencies between lisp on the old machine they should work on the new one as well. one side note: for me, When I see a compiled file here on the forum I tend to stay away from it. This forum is built on open source, and compiled code here, at least for me, is some what of a bad taste...

@dber From your post, I understood that you want to number construction detail notes from an existing MTEXT object. I put together two versions so you can try both and choose whichever suits your workflow: - Loose geometry: separate hexagon outlines, solid fills and text numbers. - Block with attribute: each marker is a block with an editable number attribute. Both versions read manual paragraph breaks in the MTEXT. Wrapped lines remain part of the same numbered paragraph, and empty paragraphs are skipped. Each hexagon is sized proportionally to the text and centered vertically beside its paragraph. Commands: - HENL / HENB: add markers beside the existing MTEXT without moving or splitting it. - HENLC / HENBC: create separate numbered paragraphs at a location you pick, with the option to keep or delete the original. You can load both files together—their commands are different. These versions are intended for single-column, non-annotative MTEXT without fields. Give them a try and let me know how they work for your example. Code below. ;;; HEXENUM 1.2 - Loose geometry | AutoCAD Windows / Visual LISP ;;; HENL / HEXENUML: number the existing MTEXT in place. ;;; HENLC / HEXENUMLC: create separate paragraphs at a picked location. ;;; Hexagon side = 1.8 x nominal text height; SOLID fill = ACI 255. ;;; Both editions can be loaded together; command and helper names are isolated. (vl-load-com) (defun R0:HENL-Fail (msg) (setq henl-msg msg) (exit)) (defun R0:HENL-Prefix (frames / result frame) (setq result "") (foreach frame (reverse frames) (setq result (strcat result "{" frame))) result) (defun R0:HENL-Close (frames / result) (setq result "") (repeat (length frames) (setq result (strcat result "}"))) result) (defun R0:HENL-Records (s / i n ch next token frames part visible result j brk start) (setq i 1 n (strlen s) frames (list "") part "{" visible nil) (while (<= i n) (setq start i ch (substr s i 1) next (substr s (1+ i) 1) brk nil) (cond ((or (= ch (chr 10)) (= ch (chr 13))) (setq brk T) (if (and (= ch (chr 13)) (= next (chr 10))) (setq i (1+ i))) (setq i (1+ i))) ((= ch "\\") (cond ((= next "P") (setq brk T i (+ i 2))) ((= next "N") (R0:HENL-Fail "Column breaks found. Set the MTEXT to a single column.")) ((member next '("\\" "{" "}" "~")) (setq part (strcat part (substr s i 2)) i (+ i 2)) (if (/= next "~") (setq visible T))) ((member next '("A" "C" "c" "F" "f" "H" "Q" "T" "W" "p" "S")) (setq j (+ i 2)) (while (and (<= j n) (/= (substr s j 1) ";")) (setq j (1+ j))) (if (> j n) (R0:HENL-Fail "Incomplete MTEXT formatting code.")) (setq token (substr s i (1+ (- j i))) part (strcat part token) i (1+ j)) (if (= next "S") (setq visible T) (setq frames (cons (strcat (car frames) token) (cdr frames))))) ((member next '("L" "l" "O" "o" "K" "k")) (setq token (substr s i 2) part (strcat part token) i (+ i 2) frames (cons (strcat (car frames) token) (cdr frames)))) ((and (= next "U") (= (substr s (+ i 2) 1) "+")) (setq part (strcat part (substr s i 7)) i (+ i 7) visible T)) (T (setq part (strcat part ch) i (1+ i) visible T)))) ((= ch "{") (setq frames (cons "" frames) part (strcat part ch) i (1+ i))) ((= ch "}") (if (null (cdr frames)) (R0:HENL-Fail "Unbalanced formatting braces.")) (setq frames (cdr frames) part (strcat part ch) i (1+ i))) (T (setq part (strcat part ch) i (1+ i)) (if (not (member ch (list " " (chr 9)))) (setq visible T)))) (if brk (progn (if visible (setq result (cons (list (strcat part (R0:HENL-Close frames)) (1- start) (R0:HENL-Close frames)) result))) (setq part (R0:HENL-Prefix frames) visible nil)))) (if (/= (length frames) 1) (R0:HENL-Fail "Unbalanced formatting braces.")) (if visible (setq result (cons (list (strcat part (R0:HENL-Close frames)) n (R0:HENL-Close frames)) result))) (reverse result)) (defun R0:HENL-Split (s) (mapcar 'car (R0:HENL-Records s))) (defun R0:HENL-Normalize (s) (while (vl-string-search (strcat (chr 13) (chr 10)) s) (setq s (vl-string-subst "\\P" (strcat (chr 13) (chr 10)) s))) (while (vl-string-search (chr 13) s) (setq s (vl-string-subst "\\P" (chr 13) s))) (while (vl-string-search (chr 10) s) (setq s (vl-string-subst "\\P" (chr 10) s))) s) (defun R0:HENL-Register (obj) (setq henl-created (cons obj henl-created)) obj) (defun R0:HENL-Box (obj / lo hi) (vla-Update obj) (vla-GetBoundingBox obj 'lo 'hi) (list (vlax-safearray->list lo) (vlax-safearray->list hi))) (defun R0:HENL-Props (obj src) (vla-put-Layer obj (vla-get-Layer src)) (vla-put-TrueColor obj (vla-get-TrueColor src)) obj) (defun R0:HENL-Text (space src content width h at attach / obj) (setq obj (R0:HENL-Register (vla-AddMText space (vlax-3d-point at) width content))) (R0:HENL-Props obj src) (vla-put-StyleName obj (vla-get-StyleName src)) (vla-put-Height obj h) (vla-put-Rotation obj 0.0) (vla-put-AttachmentPoint obj attach) (vla-put-InsertionPoint obj (vlax-3d-point at)) (vla-put-LineSpacingStyle obj (vla-get-LineSpacingStyle src)) (vla-put-LineSpacingFactor obj (vla-get-LineSpacingFactor src)) obj) (defun R0:HENL-Hex (space src center side / coords k a arr obj) (setq k 5) (repeat 6 (setq a (* pi (/ k 3.0)) coords (cons (+ (car center) (* side (cos a))) (cons (+ (cadr center) (* side (sin a))) coords)) k (1- k))) (setq arr (vlax-make-safearray vlax-vbDouble '(0 . 11))) (vlax-safearray-fill arr coords) (setq obj (R0:HENL-Register (vla-AddLightWeightPolyline space arr))) (R0:HENL-Props obj src) (vla-put-Elevation obj (caddr center)) (vla-put-Closed obj :vlax-true) (vla-put-ConstantWidth obj 0.0) (vla-put-Lineweight obj 0) obj) (defun R0:HENL-Number (space src number center h side / obj box w ht factor p q) (setq obj (R0:HENL-Text space src (itoa number) 0.0 h center 5) box (R0:HENL-Box obj) p (car box) q (cadr box) w (- (car q) (car p)) ht (- (cadr q) (cadr p)) factor (min 1.0 (/ (* side 1.45) (max w 1e-12)) (/ (* side 1.2) (max ht 1e-12)))) (if (< factor 1.0) (vla-put-Height obj (* h factor))) (setq box (R0:HENL-Box obj) p (car box) q (cadr box)) (vla-Move obj (vlax-3d-point (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p q)) (vlax-3d-point center)) obj) (defun R0:HENL-Fill (space src boundary / arr obj) (setq arr (vlax-make-safearray vlax-vbObject '(0 . 0))) (vlax-safearray-put-element arr 0 boundary) (setq obj (R0:HENL-Register (vla-AddHatch space 0 "SOLID" :vlax-false 0))) (vla-AppendOuterLoop obj arr) (vla-put-Elevation obj (vla-get-Elevation boundary)) (vla-put-Layer obj (vla-get-Layer src)) (vla-put-Color obj 255) (vla-put-EntityTransparency obj "0") (vla-Evaluate obj) (setq henl-fills (cons obj henl-fills)) obj) (defun R0:HENL-FillsBack (space / dict table arr) (if henl-fills (progn (setq dict (vla-GetExtensionDictionary space) table (vl-catch-all-apply 'vla-GetObject (list dict "ACAD_SORTENTS"))) (if (vl-catch-all-error-p table) (setq table (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable"))) (setq arr (vlax-make-safearray vlax-vbObject (cons 0 (1- (length henl-fills))))) (vlax-safearray-fill arr henl-fills) (vla-MoveToBottom table arr)))) (defun R0:HENL-CenterY (obj box cy / mid) (setq mid (/ (+ (cadar box) (cadadr box)) 2.0)) (vla-Move obj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (list 0.0 (- cy mid) 0.0))) obj) (defun R0:HENL-Discard (obj) (vla-Delete obj) (setq henl-created (vl-remove obj henl-created))) (defun R0:HENL-InPlace (space src content records height width point initial / probe single box top left side rec prefix total partheight cy center boundary number previous overlaps) (setq probe (R0:HENL-Text space src content width height point (vla-get-AttachmentPoint src))) (vla-put-Visible probe :vlax-false) (setq box (R0:HENL-Box probe) top (cadadr box) left (caar box) side (* 1.8 height) number initial overlaps 0) (vla-put-AttachmentPoint probe 1) (vla-put-InsertionPoint probe (vlax-3d-point point)) (setq single (R0:HENL-Text space src "M" width height point 1)) (vla-put-Visible single :vlax-false) (foreach rec records (setq prefix (strcat "{" (substr content 1 (cadr rec)) (caddr rec))) (vla-put-TextString probe prefix) (setq box (R0:HENL-Box probe) total (- (cadadr box) (cadar box))) (vla-put-TextString single (car rec)) (setq box (R0:HENL-Box single) partheight (- (cadadr box) (cadar box)) cy (+ (- top total) (/ partheight 2.0)) center (list (- left side (* 0.7 height)) cy (caddr point))) (if (and previous (< (abs (- previous cy)) (* (sqrt 3.0) side))) (setq overlaps (1+ overlaps))) (setq boundary (R0:HENL-Hex space src center side)) (R0:HENL-Fill space src boundary) (R0:HENL-Number space src number center height side) (setq previous cy number (1+ number))) (R0:HENL-Discard single) (R0:HENL-Discard probe) (if (> overlaps 0) (princ (strcat "\n[!] " (itoa overlaps) " pairs of hexagons may overlap: insufficient paragraph spacing."))) number) (defun R0:HENL-Initial (/ s n valid) (while (not valid) (setq s (getstring "\nStarting NUMBER <1>: ")) (if (= s "") (setq s "1")) (if (and (<= (strlen s) 9) (vl-every '(lambda (c) (and (>= c 48) (<= c 57))) (vl-string->list s))) (setq n (atoi s) valid T) (princ "\nEnter an integer from 0 to 999999999."))) n) (defun R0:HENL-Annotative (ename / data) (setq data (assoc -3 (entget ename '("AcadAnnotative")))) (and data (member '(1070 . 1) (cdr (cadr data))))) (defun R0:HENL-Select (/ pick en data layer done) (while (not done) (setq pick (entsel "\nHENL | Select the MTEXT to number <Exit>: ")) (cond ((null pick) (setq done T en nil)) (T (setq en (car pick) data (entget en) layer (tblsearch "LAYER" (cdr (assoc 8 data)))) (cond ((/= (cdr (assoc 0 data)) "MTEXT") (princ "\nSelect an MTEXT object, not single-line text or a block.")) ((/= 0 (logand 5 (cdr (assoc 70 layer)))) (princ "\nThe layer is locked or frozen.")) ((minusp (cdr (assoc 62 layer))) (princ "\nThe layer is turned off.")) (T (setq done T)))))) en) (defun R0:HENL-Cleanup (rollback / obj result) (if (and rollback henl-retiring henl-source (null (entget henl-source))) (if (not (entdel henl-source)) (princ "\n[!] Check whether the original MTEXT was restored."))) (if rollback (foreach obj henl-created (setq result (vl-catch-all-apply 'vla-Delete (list obj))) (if (vl-catch-all-error-p result) (princ "\n[!] Could not remove an output object; check the drawing.")))) (if henl-highlight (vl-catch-all-apply 'redraw (list henl-source 4))) (if henl-undo (vl-catch-all-apply 'vla-EndUndoMark (list henl-doc))) (foreach obj henl-vars (vl-catch-all-apply 'setvar (list (car obj) (cdr obj)))) (princ)) (defun R0:HENL-Run (relocate / *error* henl-msg henl-created henl-source henl-highlight henl-doc henl-undo henl-vars henl-retiring henl-fills src data content parts height width angle normal space initial option point side cy center para textobj box realheight obj number style rowheight bottom boundary records) (defun *error* (msg) (R0:HENL-Cleanup T) (cond (henl-msg (princ (strcat "\n[!] HENL: " henl-msg))) ((and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))) (princ (strcat "\n[!] HENL: " msg))) (T (princ "\nHENL canceled. Original preserved."))) (princ)) (setq henl-doc (vla-get-ActiveDocument (vlax-get-acad-object)) henl-vars (list (cons "DYNMODE" (getvar "DYNMODE")) (cons "DYNPROMPT" (getvar "DYNPROMPT")))) (setvar "DYNMODE" 3) (setvar "DYNPROMPT" 1) (if (setq henl-source (R0:HENL-Select)) (progn (setq src (vlax-ename->vla-object henl-source) data (entget henl-source) content (R0:HENL-Normalize (vla-get-TextString src)) height (vla-get-Height src) width (vla-get-Width src) angle (vla-get-Rotation src) normal (cdr (assoc 210 data)) style (tblobjname "STYLE" (vla-get-StyleName src))) (if (and normal (not (equal normal '(0.0 0.0 1.0) 1e-8))) (R0:HENL-Fail "This version requires text on a plane parallel to WCS XY.")) (if (vl-string-search "%<" content) (R0:HENL-Fail "MTEXT fields are not supported; the original has been preserved.")) (if (and (assoc 75 data) (/= 0 (cdr (assoc 75 data)))) (R0:HENL-Fail "Disable MTEXT columns before numbering.")) (if (or (= (cdr (assoc 72 data)) 3) (/= 0 (logand 4 (cdr (assoc 70 (tblsearch "STYLE" (vla-get-StyleName src))))))) (R0:HENL-Fail "Vertical text is not supported in this version.")) (if (or (R0:HENL-Annotative henl-source) (and style (R0:HENL-Annotative style))) (R0:HENL-Fail "Use non-annotative MTEXT and a non-annotative text style.")) (if (<= height 0.0) (R0:HENL-Fail "Invalid text height.")) (setq records (R0:HENL-Records content) parts (mapcar 'car records)) (if (null parts) (R0:HENL-Fail "No non-empty paragraphs found.")) (if (> (length parts) 10000) (R0:HENL-Fail "The limit is 10000 paragraphs per run.")) (redraw henl-source 3) (setq henl-highlight T) (princ (strcat "\n" (itoa (length parts)) " paragraphs | Hexagon side length: " (rtos (* 1.8 height) 2 4))) (setq initial (R0:HENL-Initial)) (if relocate (progn (initget "Keep Delete") (setq option (getkword "\nORIGINAL [Keep/Delete] <Keep>: ")) (initget 1) (setq point (trans (getpoint (strcat "\nCenter of the FIRST hexagon (" (itoa initial) "): ")) 1 0))) (setq option "Keep" point (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint src))))) (setq space (vlax-ename->vla-object (cdr (assoc 330 (reverse data))))) (if (and (= 1 (logand 1 (getvar "UNDOCTL"))) (= 0 (logand 8 (getvar "UNDOCTL")))) (progn (vla-StartUndoMark henl-doc) (setq henl-undo T))) (setq side (* 1.8 height) cy (cadr point) number initial) (if relocate (progn (foreach para parts (setq textobj (R0:HENL-Text space src para width height (list (+ (car point) side (* 0.7 height)) cy (caddr point)) 1) box (R0:HENL-Box textobj) realheight (- (cadadr box) (cadar box)) rowheight (max realheight (* (sqrt 3.0) side))) (if bottom (setq cy (- bottom (* 0.8 height) (/ rowheight 2.0)))) (R0:HENL-CenterY textobj box cy) (setq center (list (car point) cy (caddr point)) boundary (R0:HENL-Hex space src center side)) (R0:HENL-Fill space src boundary) (R0:HENL-Number space src number center height side) (setq bottom (- cy (/ rowheight 2.0)) number (1+ number)))) (setq number (R0:HENL-InPlace space src content records height width point initial))) (foreach obj henl-created (if (not (equal angle 0.0 1e-12)) (vla-Rotate obj (vlax-3d-point point) angle)) (vla-Update obj) (if (not (entget (vlax-vla-object->ename obj))) (R0:HENL-Fail "Could not verify the output."))) (if (/= (length henl-created) (* (if relocate 4 3) (length parts))) (R0:HENL-Fail "The output is incomplete.")) (R0:HENL-FillsBack space) (vla-Regen henl-doc 0) (redraw henl-source 4) (setq henl-highlight nil) (if (= option "Delete") (progn (setq henl-retiring T) (if (not (entdel henl-source)) (R0:HENL-Fail "Could not delete the original.")))) (setq henl-created nil henl-retiring nil) (R0:HENL-Cleanup nil) (princ (strcat "\n[OK] " (itoa (length parts)) " paragraphs | Numbers " (itoa initial) " to " (itoa (1- number)) " | " (if relocate (strcat "Original " (if (= option "Delete") "deleted." "preserved.")) "Original MTEXT unchanged.")))) (R0:HENL-Cleanup nil)) (princ)) (defun c:HEXENUML () (R0:HENL-Run nil)) (defun c:HENL () (R0:HENL-Run nil)) (defun c:HEXENUMLC () (R0:HENL-Run T)) (defun c:HENLC () (R0:HENL-Run T)) (princ "\nHEXENUM 1.2 (loose geometry) | HENL: number in place | HENLC: create at another point.") (princ) ;;; HEXENUM 1.3 - Block with NUM attribute | AutoCAD Windows / Visual LISP ;;; HENB / HEXENUMB: number the existing MTEXT in place. ;;; HENBC / HEXENUMBC: create separate paragraphs at a picked location. ;;; Hexagon side = 1.8 x nominal text height; SOLID fill = ACI 255. ;;; Both editions can be loaded together; command and helper names are isolated. (vl-load-com) (defun R0:HENB-Fail (msg) (setq henb-msg msg) (exit)) (defun R0:HENB-Prefix (frames / result frame) (setq result "") (foreach frame (reverse frames) (setq result (strcat result "{" frame))) result) (defun R0:HENB-Close (frames / result) (setq result "") (repeat (length frames) (setq result (strcat result "}"))) result) (defun R0:HENB-Records (s / i n ch next token frames part visible result j brk start) (setq i 1 n (strlen s) frames (list "") part "{" visible nil) (while (<= i n) (setq start i ch (substr s i 1) next (substr s (1+ i) 1) brk nil) (cond ((or (= ch (chr 10)) (= ch (chr 13))) (setq brk T) (if (and (= ch (chr 13)) (= next (chr 10))) (setq i (1+ i))) (setq i (1+ i))) ((= ch "\\") (cond ((= next "P") (setq brk T i (+ i 2))) ((= next "N") (R0:HENB-Fail "Column breaks found. Set the MTEXT to a single column.")) ((member next '("\\" "{" "}" "~")) (setq part (strcat part (substr s i 2)) i (+ i 2)) (if (/= next "~") (setq visible T))) ((member next '("A" "C" "c" "F" "f" "H" "Q" "T" "W" "p" "S")) (setq j (+ i 2)) (while (and (<= j n) (/= (substr s j 1) ";")) (setq j (1+ j))) (if (> j n) (R0:HENB-Fail "Incomplete MTEXT formatting code.")) (setq token (substr s i (1+ (- j i))) part (strcat part token) i (1+ j)) (if (= next "S") (setq visible T) (setq frames (cons (strcat (car frames) token) (cdr frames))))) ((member next '("L" "l" "O" "o" "K" "k")) (setq token (substr s i 2) part (strcat part token) i (+ i 2) frames (cons (strcat (car frames) token) (cdr frames)))) ((and (= next "U") (= (substr s (+ i 2) 1) "+")) (setq part (strcat part (substr s i 7)) i (+ i 7) visible T)) (T (setq part (strcat part ch) i (1+ i) visible T)))) ((= ch "{") (setq frames (cons "" frames) part (strcat part ch) i (1+ i))) ((= ch "}") (if (null (cdr frames)) (R0:HENB-Fail "Unbalanced formatting braces.")) (setq frames (cdr frames) part (strcat part ch) i (1+ i))) (T (setq part (strcat part ch) i (1+ i)) (if (not (member ch (list " " (chr 9)))) (setq visible T)))) (if brk (progn (if visible (setq result (cons (list (strcat part (R0:HENB-Close frames)) (1- start) (R0:HENB-Close frames)) result))) (setq part (R0:HENB-Prefix frames) visible nil)))) (if (/= (length frames) 1) (R0:HENB-Fail "Unbalanced formatting braces.")) (if visible (setq result (cons (list (strcat part (R0:HENB-Close frames)) n (R0:HENB-Close frames)) result))) (reverse result)) (defun R0:HENB-Split (s) (mapcar 'car (R0:HENB-Records s))) (defun R0:HENB-Normalize (s) (while (vl-string-search (strcat (chr 13) (chr 10)) s) (setq s (vl-string-subst "\\P" (strcat (chr 13) (chr 10)) s))) (while (vl-string-search (chr 13) s) (setq s (vl-string-subst "\\P" (chr 13) s))) (while (vl-string-search (chr 10) s) (setq s (vl-string-subst "\\P" (chr 10) s))) s) (defun R0:HENB-Register (obj) (setq henb-created (cons obj henb-created)) obj) (defun R0:HENB-Box (obj / lo hi) (vla-Update obj) (vla-GetBoundingBox obj 'lo 'hi) (list (vlax-safearray->list lo) (vlax-safearray->list hi))) (defun R0:HENB-Props (obj src) (vla-put-Layer obj (vla-get-Layer src)) (vla-put-TrueColor obj (vla-get-TrueColor src)) obj) (defun R0:HENB-Text (space src content width h at attach / obj) (setq obj (R0:HENB-Register (vla-AddMText space (vlax-3d-point at) width content))) (R0:HENB-Props obj src) (vla-put-StyleName obj (vla-get-StyleName src)) (vla-put-Height obj h) (vla-put-Rotation obj 0.0) (vla-put-AttachmentPoint obj attach) (vla-put-InsertionPoint obj (vlax-3d-point at)) (vla-put-LineSpacingStyle obj (vla-get-LineSpacingStyle src)) (vla-put-LineSpacingFactor obj (vla-get-LineSpacingFactor src)) obj) (defun R0:HENB-BlockDef (doc nom / blks blk coords k a arr pl hat lazo att) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list (vla-get-Blocks doc) nom)))) T (progn (setq blks (vla-get-Blocks doc) blk (vla-Add blks (vlax-3d-point '(0.0 0.0 0.0)) nom) k 5 coords nil) (repeat 6 (setq a (* pi (/ k 3.0)) coords (cons (cos a) (cons (sin a) coords)) k (1- k))) (setq arr (vlax-make-safearray vlax-vbDouble '(0 . 11))) (vlax-safearray-fill arr coords) (setq pl (vla-AddLightWeightPolyline blk arr)) (vla-put-Closed pl :vlax-true) (setq hat (vla-AddHatch blk 0 "SOLID" :vlax-false 0) lazo (vlax-make-safearray vlax-vbObject '(0 . 0))) (vlax-safearray-put-element lazo 0 pl) (vla-AppendOuterLoop hat lazo) (vla-put-Layer hat "0") (vla-put-Color hat 255) (vla-Evaluate hat) (vla-Delete pl) (setq pl (vla-AddLightWeightPolyline blk arr)) (vla-put-Closed pl :vlax-true) (vla-put-Layer pl "0") (vla-put-ConstantWidth pl 0.0) (setq att (vla-AddAttribute blk (/ 1.0 1.8) 0 "Number" (vlax-3d-point '(0.0 0.0 0.0)) "NUM" "1")) (vla-put-Layer att "0") (vla-put-Alignment att 10) (vla-put-TextAlignmentPoint att (vlax-3d-point '(0.0 0.0 0.0))) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list blks nom))))))) (defun R0:HENB-Marker (space src center side number / obj atts a box p q w ht factor) (setq obj (R0:HENB-Register (vla-InsertBlock space (vlax-3d-point center) "IR_HEX" side side side 0.0))) (vla-put-Layer obj (vla-get-Layer src)) (vla-put-TrueColor obj (vla-get-TrueColor src)) (setq atts (vl-catch-all-apply 'vla-GetAttributes (list obj))) (if (vl-catch-all-error-p atts) (R0:HENB-Fail "Could not read the marker attributes.") (foreach a (vlax-safearray->list (vlax-variant-value atts)) (vla-put-TextString a (itoa number)) (setq box (R0:HENB-Box a) p (car box) q (cadr box) w (- (car q) (car p)) ht (- (cadr q) (cadr p)) factor (min 1.0 (/ (* side 1.45) (max w 1e-12)) (/ (* side 1.2) (max ht 1e-12)))) (if (< factor 1.0) (vla-put-Height a (* (vla-get-Height a) factor))) (if (/= (itoa number) (vla-get-TextString a)) (R0:HENB-Fail (strcat "Marker " (itoa number) " has no number."))))) obj) (defun R0:HENB-CenterY (obj box cy / mid) (setq mid (/ (+ (cadar box) (cadadr box)) 2.0)) (vla-Move obj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (list 0.0 (- cy mid) 0.0))) obj) (defun R0:HENB-Discard (obj) (vla-Delete obj) (setq henb-created (vl-remove obj henb-created))) (defun R0:HENB-InPlace (space src content records height width point initial / probe single box top left side rec prefix total partheight cy center number previous overlaps) (setq probe (R0:HENB-Text space src content width height point (vla-get-AttachmentPoint src))) (vla-put-Visible probe :vlax-false) (setq box (R0:HENB-Box probe) top (cadadr box) left (caar box) side (* 1.8 height) number initial overlaps 0) (vla-put-AttachmentPoint probe 1) (vla-put-InsertionPoint probe (vlax-3d-point point)) (setq single (R0:HENB-Text space src "M" width height point 1)) (vla-put-Visible single :vlax-false) (foreach rec records (setq prefix (strcat "{" (substr content 1 (cadr rec)) (caddr rec))) (vla-put-TextString probe prefix) (setq box (R0:HENB-Box probe) total (- (cadadr box) (cadar box))) (vla-put-TextString single (car rec)) (setq box (R0:HENB-Box single) partheight (- (cadadr box) (cadar box)) cy (+ (- top total) (/ partheight 2.0)) center (list (- left side (* 0.7 height)) cy (caddr point))) (if (and previous (< (abs (- previous cy)) (* (sqrt 3.0) side))) (setq overlaps (1+ overlaps))) (R0:HENB-Marker space src center side number) (setq previous cy number (1+ number))) (R0:HENB-Discard single) (R0:HENB-Discard probe) (if (> overlaps 0) (princ (strcat "\n[!] " (itoa overlaps) " pairs of hexagons may overlap: insufficient paragraph spacing."))) number) (defun R0:HENB-Initial (/ s n valid) (while (not valid) (setq s (getstring "\nStarting NUMBER <1>: ")) (if (= s "") (setq s "1")) (if (and (<= (strlen s) 9) (vl-every '(lambda (c) (and (>= c 48) (<= c 57))) (vl-string->list s))) (setq n (atoi s) valid T) (princ "\nEnter an integer from 0 to 999999999."))) n) (defun R0:HENB-Annotative (ename / data) (setq data (assoc -3 (entget ename '("AcadAnnotative")))) (and data (member '(1070 . 1) (cdr (cadr data))))) (defun R0:HENB-Select (/ pick en data layer done) (while (not done) (setq pick (entsel "\nHENB | Select the MTEXT to number <Exit>: ")) (cond ((null pick) (setq done T en nil)) (T (setq en (car pick) data (entget en) layer (tblsearch "LAYER" (cdr (assoc 8 data)))) (cond ((/= (cdr (assoc 0 data)) "MTEXT") (princ "\nSelect an MTEXT object, not single-line text or a block.")) ((/= 0 (logand 5 (cdr (assoc 70 layer)))) (princ "\nThe layer is locked or frozen.")) ((minusp (cdr (assoc 62 layer))) (princ "\nThe layer is turned off.")) (T (setq done T)))))) en) (defun R0:HENB-Cleanup (rollback / obj result) (if (and rollback henb-retiring henb-source (null (entget henb-source))) (if (not (entdel henb-source)) (princ "\n[!] Check whether the original MTEXT was restored."))) (if rollback (foreach obj henb-created (setq result (vl-catch-all-apply 'vla-Delete (list obj))) (if (vl-catch-all-error-p result) (princ "\n[!] Could not remove an output object; check the drawing.")))) (if henb-highlight (vl-catch-all-apply 'redraw (list henb-source 4))) (if henb-undo (vl-catch-all-apply 'vla-EndUndoMark (list henb-doc))) (foreach obj henb-vars (vl-catch-all-apply 'setvar (list (car obj) (cdr obj)))) (princ)) (defun R0:HENB-Run (relocate / *error* henb-msg henb-created henb-source henb-highlight henb-doc henb-undo henb-vars henb-retiring src data content parts height width angRot normal space initial option point side cy center para textobj box realheight obj number style rowheight bottom records) (defun *error* (msg) (R0:HENB-Cleanup T) (cond (henb-msg (princ (strcat "\n[!] HENB: " henb-msg))) ((and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))) (princ (strcat "\n[!] HENB: " msg))) (T (princ "\nHENB canceled. Original preserved."))) (princ)) (setq henb-doc (vla-get-ActiveDocument (vlax-get-acad-object)) henb-vars (list (cons "DYNMODE" (getvar "DYNMODE")) (cons "DYNPROMPT" (getvar "DYNPROMPT")))) (setvar "DYNMODE" 3) (setvar "DYNPROMPT" 1) (if (setq henb-source (R0:HENB-Select)) (progn (setq src (vlax-ename->vla-object henb-source) data (entget henb-source) content (R0:HENB-Normalize (vla-get-TextString src)) height (vla-get-Height src) width (vla-get-Width src) angRot (vla-get-Rotation src) normal (cdr (assoc 210 data)) style (tblobjname "STYLE" (vla-get-StyleName src))) (if (and normal (not (equal normal '(0.0 0.0 1.0) 1e-8))) (R0:HENB-Fail "This version requires text on a plane parallel to WCS XY.")) (if (vl-string-search "%<" content) (R0:HENB-Fail "MTEXT fields are not supported; the original has been preserved.")) (if (and (assoc 75 data) (/= 0 (cdr (assoc 75 data)))) (R0:HENB-Fail "Disable MTEXT columns before numbering.")) (if (or (= (cdr (assoc 72 data)) 3) (/= 0 (logand 4 (cdr (assoc 70 (tblsearch "STYLE" (vla-get-StyleName src))))))) (R0:HENB-Fail "Vertical text is not supported in this version.")) (if (or (R0:HENB-Annotative henb-source) (and style (R0:HENB-Annotative style))) (R0:HENB-Fail "Use non-annotative MTEXT and a non-annotative text style.")) (if (<= height 0.0) (R0:HENB-Fail "Invalid text height.")) (setq records (R0:HENB-Records content) parts (mapcar 'car records)) (if (null parts) (R0:HENB-Fail "No non-empty paragraphs found.")) (if (> (length parts) 10000) (R0:HENB-Fail "The limit is 10000 paragraphs per run.")) (redraw henb-source 3) (setq henb-highlight T) (princ (strcat "\n" (itoa (length parts)) " paragraphs | Hexagon side length: " (rtos (* 1.8 height) 2 4))) (setq initial (R0:HENB-Initial)) (if relocate (progn (initget "Keep Delete") (setq option (getkword "\nORIGINAL [Keep/Delete] <Keep>: ")) (initget 1) (setq point (trans (getpoint (strcat "\nCenter of the FIRST hexagon (" (itoa initial) "): ")) 1 0))) (setq option "Keep" point (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint src))))) (setq space (vlax-ename->vla-object (cdr (assoc 330 (reverse data))))) (if (and (= 1 (logand 1 (getvar "UNDOCTL"))) (= 0 (logand 8 (getvar "UNDOCTL")))) (progn (vla-StartUndoMark henb-doc) (setq henb-undo T))) (if (not (R0:HENB-BlockDef henb-doc "IR_HEX")) (R0:HENB-Fail "Could not create the IR_HEX block.")) (setq side (* 1.8 height) cy (cadr point) number initial) (if relocate (progn (foreach para parts (setq textobj (R0:HENB-Text space src para width height (list (+ (car point) side (* 0.7 height)) cy (caddr point)) 1) box (R0:HENB-Box textobj) realheight (- (cadadr box) (cadar box)) rowheight (max realheight (* (sqrt 3.0) side))) (if bottom (setq cy (- bottom (* 0.8 height) (/ rowheight 2.0)))) (R0:HENB-CenterY textobj box cy) (setq center (list (car point) cy (caddr point))) (R0:HENB-Marker space src center side number) (setq bottom (- cy (/ rowheight 2.0)) number (1+ number)))) (setq number (R0:HENB-InPlace space src content records height width point initial))) (foreach obj henb-created (if (not (equal angRot 0.0 1e-12)) (vla-Rotate obj (vlax-3d-point point) angRot)) (vla-Update obj) (if (not (entget (vlax-vla-object->ename obj))) (R0:HENB-Fail "Could not verify the output."))) (if (/= (length henb-created) (* (if relocate 2 1) (length parts))) (R0:HENB-Fail "The output is incomplete.")) (vla-Regen henb-doc 0) (redraw henb-source 4) (setq henb-highlight nil) (if (= option "Delete") (progn (setq henb-retiring T) (if (not (entdel henb-source)) (R0:HENB-Fail "Could not delete the original.")))) (setq henb-created nil henb-retiring nil) (R0:HENB-Cleanup nil) (princ (strcat "\n[OK] " (itoa (length parts)) " paragraphs | Numbers " (itoa initial) " to " (itoa (1- number)) " | " (if relocate (strcat "Original " (if (= option "Delete") "deleted." "preserved.")) "Original MTEXT unchanged.")))) (R0:HENB-Cleanup nil)) (princ)) (defun c:HEXENUMB () (R0:HENB-Run nil)) (defun c:HENB () (R0:HENB-Run nil)) (defun c:HEXENUMBC () (R0:HENB-Run T)) (defun c:HENBC () (R0:HENB-Run T)) (princ "\nHEXENUM 1.3 (block + attribute) | HENB: number in place | HENBC: create at another point.") (princ)

I use this in visual studio to toggle between header and source. also since I'm a southpaw, I use home and end for copy paste autohotkey is the GOAT! #z::Run www.autohotkey.com ;ALT + XX ; home::send ^c ; end::send ^v ; #IfWinActive ahk_exe devenv.exe ;PgUp::SendRaw `,DS.ARGS() ;misc command ;PgDn::SendRaw `,DS.ARGS({"val:type"}) ;misc command Insert::send ^k^o ;toggle header/source Delete::send ^a^k^f{Esc} ;select all and format #IfWinActive

You can give this a try: (defun filePicker (directory filename extension / appHandle des pickedFile pickedFiles shell tmp tmpopen tmpoutput line) ;; Multi-file FilePicker using PowerShell OpenFileDialog ;; Returns a list of selected full file paths. ;; Returns nil if Cancel is pressed. (cond ;; Create temporary .BAT file ((and (setq tmp (vl-filename-mktemp nil nil ".bat")) (setq des (open tmp "w")) (write-line (strcat "<# : chooser.bat\n" ":: launches a File... Open sort of file chooser\n" "@echo off\n" "setlocal\n" "for /f \"delims=\" %%I in ('powershell -noprofile \"iex (${%~f0} | out-string)\"') do (\n" " echo %%~I\n" ")\n" "goto :EOF\n" ": end Batch portion / begin PowerShell hybrid chimera #>\n" "Add-Type -AssemblyName System.Windows.Forms\n" "$f = New-Object System.Windows.Forms.OpenFileDialog\n" "$f.InitialDirectory = \"" directory "\"\n" "$f.FileName = \"" filename "\"\n" "$f.Filter = \"" (cond ((= "dwg" (strcase extension t)) "AutoCAD Drawing (*.dwg)|*.dwg") ((= "dxf" (strcase extension t)) "AutoCAD DXF (*.dxf)|*.dxf") (t "All Files (*.*)|*.*") ) "\"\n" "$f.FilterIndex = 1\n" "$f.DefaultExt = \"" extension "\"\n" "$f.Multiselect = $true\n" "$f.ShowHelp = $true\n" "if ($f.ShowDialog() -eq [System.Windows.Forms.DialogResult]::OK) {\n" " $f.FileNames | ForEach-Object { $_ }\n" "}" ) des ) ) (not (close des)) (setq tmpoutput (vl-filename-mktemp nil nil ".txt")) (setq shell (vla-getinterfaceobject (vlax-get-acad-object) "WScript.shell")) (setq appHandle (vl-catch-all-apply 'vlax-invoke (list shell 'Run (strcat "cmd /c " tmp " > " tmpoutput) 0 :vlax-false))) (vlax-release-object shell) (not (vl-catch-all-error-p appHandle)) (setq tmpopen (open tmpoutput "r")) (while (setq line (read-line tmpopen)) (if (/= line "") (setq pickedFiles (append pickedFiles (list line)) ) ) ) (close tmpopen) (setq pickedFile pickedFiles) ) ((setq pickedFile (getfiled "" (strcat directory filename) extension 0)) (setq pickedFile (list pickedFile)) ) ) (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp) ) (if (and tmpoutput (setq tmpoutput (findfile tmpoutput))) (vl-file-delete tmpoutput) ) pickedFile )

Yes, I was working on that for my home computer with 2000i. Since I had some home time today with AutoCAD 2000i, I did some updating to your code. Seems to work great with minimal testing. Here is my Test Code... ; ================================================================ ; Test command ; ================================================================ (defun c:SelectDWGs (/ files) (setq files (pl:getfiledps "Select DWG Files" (getvar "DWGPREFIX") "dwg" 1 ) ) (if files (progn (princ "\nSelected files:" ) (foreach file files (princ (strcat "\n" file ) ) ) ) (princ "\nNo files selected." ) ) (princ) ) pl_getfiledps_2000i.lsp

@SLW210 Note - There are several system variables (saved in the drawing) you can change to make the CENTERMARK command behave the way you want: CENTERLAYER = Default Layer CENTERLTYPE = Default LT (can be set to CONTINUOUS) CENTERLTSCALE = Centermark LT Scale CENTERLTYPEFILE = Center LT File used (like acad.lin) CENTERMARKEXE = Centermark Extensions ON/OFF CENTERCROSSGAP = Centermark Cross Gap value (can be relative or hard number) CENTERCROSSSIZE = Centermark Cross Size (can be relative or hard number) CENTEREXE = Centermark Extension Distance

Def going to use some coding from this. Thought id share a few different options that i came up with over the years. check error message agaist a list (if (not (member msg '("Console Break" "Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) using cond inside setq for default option. (initget "Select Current All") (setq mode (cond ((getkword "\nMode [<Select>/Current/All]: ")) ("Select") ) )

Have you tried: https://www.lee-mac.com/associativecenterlines.html ?

This looks amazing! Thank you so much! I did notice a couple random multi-line blocks were placed on the 1st line, but other than that this is amazing!

Made the notes in Word with a hexagon font. The indents are Character plus a period, that is why second hexagon appears, looking at setting Word style not "A." but "A" only. Can do numbers as well. Copied to Bricscad but the font is not supported in Bricscad to old a font, yes found that out. removed period from bullet style. If you open your notes in word should be able to reset the bullets and save then into MTEXT. In Bricscad with a bit of care you can highlite the bullet character and change it to another font, ie a hexagon font. Hopefully only need to do once. and save your notes, then you add or remove paragraphs. The one above is called HEX:gon Expanded. Above 9 get two hexagons. A-Z is ok tested on Word Doc.

That's g r e a t!

an AI translation (defun c:ldoit ( / ss i ent dxf x1 x2 rot normal dirVec vAxis projDist newX2 ) ;; 1. Select only DIMENSION objects (setq ss (ssget '((0 . "DIMENSION")))) (if ss (progn ;; Iterate backwards through the selection set (repeat (setq i (sslength ss)) (setq i (1- i)) (setq ent (ssname ss i)) (setq dxf (entget ent)) ;; Ensure it is specifically a Rotated/Linear dimension (if (member '(100 . "AcDbRotatedDimension") dxf) (progn ;; 2. Corrected DXF Codes: 13 maps to xLine1Point, 14 maps to xLine2Point (setq x1 (cdr (assoc 13 dxf))) ; xLine1Point (Defpoint 1) (setq x2 (cdr (assoc 14 dxf))) ; xLine2Point (Defpoint 2) (setq rot (cdr (assoc 50 dxf))) ; Rotation angle (in radians) (setq normal (cdr (assoc 210 dxf))) ; Normal Vector ;; 3. Compute direction vector based on rotation angle (setq dirVec (list (cos rot) (sin rot) 0.0)) ;; 4. Vector subtraction: vAxis = x2 - x1 (setq vAxis (mapcar '- x2 x1)) ;; 5. Dot Product: vAxis . dirVec (setq projDist (+ (* (car vAxis) (car dirVec)) (* (cadr vAxis) (cadr dirVec)) (* (caddr vAxis) (caddr dirVec)))) ;; 6. Calculate new X2 point: x1 + (dirVec * projDist) (setq newX2 (list (+ (car x1) (* (car dirVec) projDist)) (+ (cadr x1) (* (cadr dirVec) projDist)) (+ (caddr x1) (* (caddr dirVec) projDist)))) ;; 7. Replace the old DXF 14 (xLine2Point) with the calculated coordinates (setq dxf (subst (cons 14 newX2) (assoc 14 dxf) dxf)) ;; 8. Update and refresh the entity in the CAD database (entmod dxf) (entupd ent) ) ) ) ) ) (princ) )

So the blocks are easy to make with an attribute for the number. Have the attribute with a default value such as '.' If you have one block entered with the attribute competed, this should allow you to increment the others - you need to select the first block attribute to get the value needed and then hit each other attribute in turn to add the next number. Try this LISP for incremental numbering - a part of something much larger so perhaps it isn't as nice as it could be but it works. This should also work for lettering (A -> B, and 1A ->1B, A1 ->A2) Then just have to split the mtext into parts I think - Lee Macs string to list can do part of this - just making a note in case I get time tomorrow to do that for you. Suspect you will need 2 LISPS, the one below to number the block attributes and one to split the text. (defun c:ctx+ ( / increment sel ) ;;Sub Functions (defun LM:roundm ( n m ) ;;http://www.lee-mac.com/round.html (* m (atoi (rtos (/ n (float m)) 2 0))) ) (defun uprev (base sel increments / ent entlst currentrevision revlength revisionprefix anumber ones leadingzero revcode revletter revnumber leadingzeros RL) ;;Sub routines (defun itsnotadate ( increments revlength entlst currentrevision base revisionprefix anumber / currentrevision revlength revisionprefix anumber ones leadingzero revcode revletter) (if (or (= (rtos (atof currentrevision)) currentrevision) (= (type currentrevision) 'INT) ) ; endor (progn (if (= (type currentrevision) 'STR) (setq revletter (+ (atof currentrevision) increments )) (setq revletter (+ currentrevision increments)) ) ; end if (setq revletter (rtos revletter)) ) ; end progn numbers only (progn (setq increments (LM:roundm increments 1 )) ;; set increments to integer, nearest nth (if (< 0 revlength) (progn (setq ones (substr currentrevision revlength)) (if (numberp (read ones))(setq anumber 1)) ) ) ;end if end progn (setq RL 0) ; length or numerical part (while (< RL revlength) (if (and (= RL anumber) (numberp (read (substr (substr currentrevision (- revlength RL) RL ) 1 1)))) (setq anumber (+ RL 1))) (setq RL (+ RL 1)) ) ; end while ;;work out numerical revision. (if (> anumber 0) (progn (setq revnumber (substr currentrevision (- revlength (- anumber 1)) anumber)) (setq revnumber (itoa (+ increments (read revnumber)))) ;;increase rev number by 1 (if (and (> revlength anumber)(/= revlength anumber)) (setq revisionprefix (substr currentrevision 1 (- revlength anumber))) ;;first characters of revision ) ; end if ;;fix leading zeros (setq leadingzeros (- anumber (strlen revnumber))) (setq leadingzero "") (repeat leadingzeros (setq leadingzero (strcat leadingzero "0")) ) ; end repeat (setq revletter (strcat revisionprefix leadingzero revnumber)) ) ; end progn ) ; end if anumber > 0 ;;Work out letters revisions (if (= anumber 0) (progn (setq revcode (+ increments (ascii ones))) ;;increase rev letter by 1 ;;set exceptions here ; (if (= 73 revcode)(setq revcode 74)) ;;I ;; if Rev Box, skip I ; (if (= 79 revcode)(setq revcode 80)) ;;O ;; If Rev Box, skip O ; (if (= 105 revcode)(setq revcode 106)) ;;i ; (if (= 111 revcode)(setq revcode 112)) ;;o.. its of to work we go. (if (= 91 revcode)(setq revcode 65)) ;;Z -> A. Won't increment 'tens' value (if (= 123 revcode)(setq revcode 97)) ;;z -> a Won't increment 'tens' value (setq revisionprefix (substr currentrevision 1 (- revlength 1))) ;;first characters of revision (setq revletter (strcat revisionprefix (chr revcode))) ) ; end progn ) ; end if ) ; end progn alpha-numeric ) ; end if number processing revletter ) ; end defun not date ;;;;;;;;;;;;;; (if (= (type sel) 'LIST) ; if selection is (<entname> (0 1 2)) or just <entname> (setq ent (car sel)) (setq ent sel) ) (setq entlst (entget ent)) ;;entity definiton (setq currentrevision base) ;;text string passed to function (setq revlength (strlen currentrevision)) ;;length of selected revision (setq revisionprefix "") ;;set prefix to blank (setq anumber 0) ;;a counter (setq revletter (itsnotadate increments revlength entlst currentrevision base revisionprefix anumber) ) (setq entlst (subst (cons 1 revletter) (assoc 1 entlst) entlst)) (entmod entlst) (entupd ent) revletter ) (if (= increments nil)(setq increments 1) ) ;; Checks if increments is a value (if (= (type increments) 'STR) (if (= nil (distof increments)) (setq increments 1) (setq increments (distof increments)) ) ) (setq increments (atoi (rtos increments))) (setq endloop "No") ; a marker (setq sel "1") ; Increment amount (while (= endloop "No") ; Select a text of enter a value loop (initget "4 3 2 1 0 -1 -2 -3 -4 Exit") ; increment amount accepted. Increase list if needed (setq sel (nentsel (strcat "\nSelect Text or Enter Text Increment (" (itoa increments) ") [3/2/1/0/-1/-2/-3/Exit]: ") ) ) (cond ( (null sel)(setq endloop "Yes") ) ( (= "Exit" sel)(princ)(exit) ) ((member sel '("-4" "-3" "-2" "-1" "0" "1" "2" "3" "4")) (setq increments (atoi sel)) ) ( (if (and (cdr (assoc 1 (entget (car sel))))(wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB,*LEADER") ) (setq endloop "Yes")) ) ( (if (not (wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB,*LEADER") ) (princ "\nThats not text...\n")) ) ) ) ;;end while (setq endloop "No") (setq ent (car sel)) (setq entlst (entget ent)) (setq base (cdr (assoc 1 entlst))) (setq base (vl-string-right-trim " " base)) ;; remove trailing spaces (princ ": ")(princ base) (if (= increment nil) (setq increment increments)) (while (while (= endloop "No") (setq sel (nentsel "\nSelect Text to Replace and Increment: ") ) (cond ( (null sel)(setq endloop "Yes") ) ( (= "Exit" sel)(princ)(exit) ) ( (if (and (cdr (assoc 1 (entget (car sel))))(wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB,*LEADER") ) (setq endloop "Yes")) ) ( (if (not (wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB,*LEADER") ) (princ "\nThats not text...\n")) ) ) ) ;;end while (princ (uprev base sel increment)) (setq endloop "No") (setq increment (+ increment increments)) );;end while (setvar "CMDECHO" 0) (command "regen") ;;in case of nested blocks (setvar "CMDECHO" 1) (princ) )

;;; DIMFL - Shorten the extension lines of selected dimensions. ;;; ;;; Applies a per-dimension override of DIMFXLON / DIMFXL, so the extension line ;;; starts at a fixed distance from the dimension line instead of at the ;;; definition point. Fixes the dimensions you pick, not the whole style. ;;; ;;; NO MEASUREMENT CHANGES. Definition points are not moved; only how far the ;;; extension line is DRAWN. A 50 stays a 50. ;;; Reversible with the Restore option. One Ctrl+Z undoes the whole pass. ;;; ;;; WARNING: if a dimension looks wrong because its definition point MOVED, this ;;; fixes the look but not the value, and makes the error harder to spot. Check ;;; the numbers before shortening anything. (vl-load-com) (defun R0:DFL-Get (obj prop / r) (setq r (vl-catch-all-apply 'vlax-get (list obj prop))) (if (vl-catch-all-error-p r) nil r)) (defun R0:DFL-Put (obj prop val / r) (setq r (vl-catch-all-apply 'vlax-put (list obj prop val))) (not (vl-catch-all-error-p r))) ;; (logand 4 nil) throws, so a missing layer record answers "not locked". (defun R0:DFL-Bloqueada (en / cap) (setq cap (tblsearch "LAYER" (cdr (assoc 8 (entget en))))) (and cap (= 4 (logand 4 (cdr (assoc 70 cap)))))) ;; Default length = whatever the first picked dimension already carries. Whoever ;; set up the style usually chose a number that suits the drawing scale. (defun R0:DFL-Sugerido (ss / i en obj v) (setq i 0 v nil) (while (and (< i (sslength ss)) (null v)) (setq en (ssname ss i) i (1+ i) obj (vlax-ename->vla-object en) v (R0:DFL-Get obj 'ExtLineFixedLen)) (if (or (not (numberp v)) (<= v 1e-9)) (setq v nil))) (if v v 2.5)) (defun c:DIMFL ( / *error* ss i en obj largo sug modo hechos fallo bloq und doc) (defun *error* (msg) (if und (vl-catch-all-apply 'vla-EndUndoMark (list doc))) (if (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*,*ABORT*"))) (princ (strcat "\n[X] DIMFL: " msg))) (princ)) (princ "\nDIMFL | Shorten extension lines (no measurement is changed).") (princ "\n Select dimensions: ") (if (null (setq ss (ssget '((0 . "DIMENSION"))))) (princ "\n[!] DIMFL: nothing selected.") (progn (princ "\n Shorten = fixed length extension lines") (princ "\n Restore = back to starting at the definition point (LONG again)") (initget "Shorten Restore") (setq modo (getkword "\n [Shorten/Restore] <Shorten>: ")) (if (null modo) (setq modo "Shorten")) (if (= modo "Shorten") (progn (setq sug (R0:DFL-Sugerido ss)) (initget 6) (setq largo (getdist (strcat "\n Extension line length <" (rtos sug 2 3) ">: "))) (if (null largo) (setq largo sug)))) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) und T) (vla-StartUndoMark doc) (setq i 0 hechos 0 fallo 0 bloq 0) (while (< i (sslength ss)) (setq en (ssname ss i) i (1+ i)) (if (R0:DFL-Bloqueada en) (setq bloq (1+ bloq)) (progn (setq obj (vlax-ename->vla-object en)) ;; ExtLineFixedLen = DIMFXL, ExtLineFixedLenSuppress = DIMFXLON. ;; Despite the "Suppress" name the value follows DIMFXLON: 0 = off ;; (long lines), -1 = on (fixed length). Length first, switch second. (if (= modo "Shorten") (if (and (R0:DFL-Put obj 'ExtLineFixedLen largo) (R0:DFL-Put obj 'ExtLineFixedLenSuppress -1)) (setq hechos (1+ hechos)) (setq fallo (1+ fallo))) (if (R0:DFL-Put obj 'ExtLineFixedLenSuppress 0) (setq hechos (1+ hechos)) (setq fallo (1+ fallo)))) (vl-catch-all-apply 'vla-Update (list obj))))) (vla-EndUndoMark doc) (setq und nil) (princ (strcat "\n\n[OK] DIMFL: " (itoa hechos) " dimension(s) " (if (= modo "Shorten") (strcat "with a " (rtos largo 2 3) " extension line") "restored: their lines are LONG again"))) (if (> bloq 0) (princ (strcat "\n " (itoa bloq) " on locked layers: skipped."))) (if (> fallo 0) (princ (strcat "\n " (itoa fallo) " did not accept the change."))) (if (= modo "Shorten") (princ "\n No measurement changed. To revert: DIMFL, Restore option.") (princ "\n To shorten them again: DIMFL, Shorten option.")))) (princ)) (princ "\n[DIMFL] loaded. Type DIMFL to shorten extension lines.") (princ)

At a fishing weigh in a 3 shoe long fish was photographed, submitted and then disqualified as its accurate length could not be established. Often when looking at outside projects would pace a length as a guide. Then use real length for design.

Attached is an improved version of getfiled that implements powershell with the option to select single or multiple files returning a list of the selected item(s): Examples: (pl:getfiledps "Select Files" (getvar"dwgprefix") "dwg" 0) ; for single selection of file type dwg (pl:getfiledps "Select Files" (strcat (getenv "userprofile") "\\downloads") "dwg;dxf" 1) ; for multiple selection of file types dwg & dxf Feedback & comments are welcome. pl_getfiledps.lsp

@Dadgad Actually I even went as far as creating a lisp command so I can make the selections to dwgunits within a dcl gui instead of looking at the dull command line interface. https://marketplace.autodesk.com/apps/5190d5ec-0b6a-4b70-b089-2753abcb8e3a?priceId=bfbb3227-aa55-4923-b9e6-7fe3db0a0a5b

This is something I hate to do, but sometimes I'm in a hurry. One title block may be different in some fundamental way. I can't just explode it, because I'll lose all the information in the attributes. There's not enough time to create an entire block for one sheet, and why bother when there's only one? So it's time to Burst a move (sorry).

That sounds like a fake Norton Pop-Up, ISeeYou, used to be (is?) an older vulnerability for web cams, I guy was activating webcams without the activation light on and blackmailing women with photos, he was caught and arrested a while back. I'll look for the article. Here is the Wiki iSeeYou - Wikipedia This looks to be a good while back.

I put in to Claude Opus 5. Attached is the result. It took a couple of minutes or so, with one revision. LTCOUNT_1.lsp

Though I would quite often check because I would need to change the PRECISION or make sure the INSUNITS are correctly set by using the UNITS command, I would seldom check the actual drawing units by using the -DWGUNITS command. I would say it's most important to make sure the current units are recognized by AutoCAD as mm or inches and etc than if it's Architectural/Engineering/Decimal.

I am curious to understand what the problem is. Right now, I am working 400 km away from home and only have access to an old PC running Windows 10 and AutoCAD 2002. I must say that this code actually works for me. I will try testing it soon on a more recent version of AutoCAD, and then perhaps I’ll add a further comment.

I usually just keep it docked on the right side and use ctrl+1 to open it if needed. any of these will open properties (command "Properties") (command "PR") (command "CH") (command "MO")

I added a note in the file where to change to keep PowerShell open. ; ---------------------------------------------------------- ; Wait until PowerShell finishes. ; ---------------------------------------------------------- (vlax-invoke-method shell "Run" cmd 0 ; <=== Change 0 to 1 if you want PowerShell to stay open. :vlax-true ) (vlax-release-object shell) ) ) I was running some tests at work to see if there was a method to determine if PowerShell was blocked to give a message... (princ "\nPowerShell access is blocked.") (princ "\nPowerShell access is allowed.")) Right now all I get on the commandline is... error: Automation Error. Description was not provided. Though I had to get to some of my "paid to do" work done yesterday. This is probably above my pay grade. I just realized who the OP is, a big time Guru over at Autodesk forums and AUGI.

Here's a simple workaround. When you get a drawing from someone else, open a New drawing (from one of your templates). Xref their drawing into that one and Bind it as an insertion. That gives you a block, which you can edit to clean it up and then explode. If there's a scale problem, it will show up there. Voila! You have their drawing with all your settings applied.

I use a variation of the ssx.lsp to select objects in the drawing. In Bricscad v15 using (sssetfirst ss1 ss1) would both activate grips and activate the properties window to show info on those objects. For example select all blocks with same name, I could quickly edit the attribute value for all of them. I'm testing upgrade to v26 and the properties window no longer activates unless I manually toggle the property preview button. Is there a system variable to use the old behavior? Here is the simple code: (setq ss1 (ssget)) (sssetfirst ss1 ss1)

A bit of googling check your version is past 26.2.07. can't check because i don't have V26 A regression in BricsCAD V26.2.5 caused the Properties window and other GUI components to stop updating during LISP execution, particularly when waiting for user input. This issue was identified as a regression and has been fixed in V26.2.07 (and subsequent builds). If you are experiencing this behavior: Update BricsCAD: Ensure you are running V26.2.07 or a newer version where the fix is included. Check System Variables: LISP scripts may inadvertently set FILEDIA or CMDDIA to zero, preventing dialog updates. Ensure your code resets these variables or uses an error handler to restore them upon cancellation. Alternative Property Access: For object properties not updating via COM, BricsCAD supports non-COM functions like (getpropertyvalue), (setpropertyvalue), (ispropertyreadonly), and (dumpallproperties) which work across Windows, Mac, and Linux.

I never used dimbreak before so but can you use a lisp select all the dim and test which ones which have DimBreaks applied to the then just re-set them.? Test on a few drawings first (make sure run it on back version)... I did this with the help of ai... but it appears to work for me... (perhaps some can verify and improve on it) I'm on on Version 2027 Map but his worked for me. I have notice two things if the dimension are not on screen and the object it crosses are a layer that is off the break reset doesn't work. (So I added zoom extents and do both layer on and thaw for any layer that is printable. Then at the end I reset everything back. But it may be better to do that before you start... as I seen AutCAD behaving strange... Where some lisp functions run before the previous task is complete... (defun c:RefreshDimBreaks ( / layers oldecho i data name flags plot off frozen answer item viewctr viewsize) (setq oldecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq viewctr (getvar "VIEWCTR")) (setq viewsize (getvar "VIEWSIZE")) (setq layers '()) (if (tblnext "LAYER" T) (progn (while (setq data (tblnext "LAYER")) (setq name (cdr (assoc 2 data))) (setq flags (cdr (assoc 70 data))) (setq plot (cdr (assoc 290 data))) (setq off (< (cdr (assoc 62 data)) 0)) (setq frozen (= (logand flags 1) 1)) (if (and (= (if plot plot 1) 1) (or off frozen)) (setq layers (cons (list name off frozen) layers)) ) ) ) ) (if (> (length layers) 0) (progn (princ (strcat "\nFound " (itoa (length layers)) " printable layers that are off or frozen.")) (initget "Y N") (setq answer (getstring T "\nTurn these layers on and thaw them temporarily? [Y/N] <N>: ")) (if (or (= answer "") (= (strcase answer) "N")) (princ "\nNo changes made.") (if (= (strcase answer) "Y") (progn (foreach item layers (command "_.-LAYER" "_ON" (car item) "") (command "_.-LAYER" "_THAW" (car item) "") ) ) ) ) ) (princ "\nNo printable layers are off or frozen.") ) (RefreshDims) (foreach item layers (if (cadr item) (command "_.-LAYER" "_OFF" (car item) "") ) (if (caddr item) (command "_.-LAYER" "_FREEZE" (car item) "") ) ) (princ "\nOriginal layer states restored.") (command "_.ZOOM" "_C" viewctr viewsize) (command "_.REGEN") (setvar "CMDECHO" oldecho) (princ) ) (defun RefreshDims ( / ss ssBreak oldecho i ent dict 360type) (setq oldecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (command "_.ZOOM" "_E") (if (setq ss (ssget "_X" '((0 . "DIMENSION")))) (progn (setq ssBreak (ssadd)) (setq i 0) (while (< i (sslength ss)) (setq ent (ssname ss i)) (if (setq dict (cdr (assoc 360 (entget ent)))) (progn (setq 360type (cdr (assoc 0 (entget dict)))) (if (= 360type "DICTIONARY") (ssadd ent ssBreak) ) ) ) (setq i (+ i 1)) ) (if (> (sslength ssBreak) 0) (progn (princ (strcat "\nRefreshing " (itoa (sslength ssBreak)) " dimension breaks.")) (command "_.DIMBREAK" "_M" ssBreak "" "_R") (command "_.DIMBREAK" "_M" ssBreak "" "_A") ) (princ "\nNo dimensions with extension dictionaries found.") ) ) (princ "\nDrawing does not have any dimensions") ) (setvar "CMDECHO" oldecho) (princ) )

Fair enough, Steven! If your current company drive setup is humming along without friction for your team, there is genuinely zero reason to disrupt what already works for you. Just to clear up one quick technical misconception for anyone following along: VedaCAD isn't an online file store (it's purely an environment deployment manager), and there is no password fatigue here—the platform is completely passwordless (supporting modern Enterprise SSO, OAuth, and Magic Links). Different tools for different office architectures. Wishing you and your CAD team smooth drafting!

J2lstaples, I have been using AI a bit lately, When I code a bigger project even small ones I write numerous defuns the reason being they solve one task but a program may need 5 task defuns. Also I can test that defun and make sure its working correctly rather having one great big program and trying to find where it is not working. But sometimes the AI just does not work for a defun task so have to go back to searching old fashioned way. You can use AI but you have to know how to describe a task, knowing who some lisp functions like SSget work with filters. Not sure what AI would think of this, I will do old fashioned way. "Drag line over multiple parallel p/Lines get two out side linework, offset both outward further make a box, now ssget text on a layer within that box. Also get how many lines, Then sort and count the text multiplied by the number of lines and put results in a table." Yes it is a current post request, not here at Cadtutor. I am interested in what AI can do and how long it takes to make something that works.

@GLAVCVSI just tried commenting out that line as you recommended but still no joy. The freezing up now also occurs on the Win 11 OS. Even after I unfreeze the Select Files window, I still cannot Cancel out but I must make a file selection to dismiss the window. The behavior just seems very unstable with a persistent powershell setup at least on the systems I tested at my end. But thanks for your feedback & code revisions. Perhaps others here can use this faster alternative if it's stable running the code this way on their systems.

The last line of code (pl:getfiledps "Hola" "c:\\" "dwg" 1) is for testing purposes and should not be loaded at startup. Comment it out, save the changes, and open a new drawing to reload the code. Once the file has loaded, you can execute (pl:getfiledps "Hola" "c:\\" "dwg" 1). The reason for this is that PowerShell runs asynchronously, and `pl:getfiledps` might execute before the PowerShell instance is available.

You can start a PowerShell instance from LISP and keep it running in the background, ready to receive instructions. I've played around with this idea a little and ended up with the following code. I haven't tested it thoroughly enough, so its robustness could probably be improved. But it may be useful. (defun PS-START (/ fp sh cmd n) (vl-load-com) ;| -------------------------------------------------------------- ; Si existe READY, suponemos de momento que ya está funcionando. ; Posteriormente podemos hacer PS-ALIVE más rigurosa. |; -------------------------------------------------------------- (setq *PS-SERVER* (strcat (getenv "TEMP") "\\PL_PS_Server.ps1") *PS-TCMD* (strcat (getenv "TEMP") "\\PL_PS_Command.tmp") *PS-CMD* (strcat (getenv "TEMP") "\\PL_PS_Command.txt") *PS-OUT* (strcat (getenv "TEMP") "\\PL_PS_Output.txt") *PS-READY* (strcat (getenv "TEMP") "\\PL_PS_Ready.txt") ) (if (and *PS* (findfile *PS-READY*)) T (progn ;|Clean previous files / Limpiar archivos anteriores|; (if (findfile *PS-CMD*) (vl-file-delete *PS-CMD*) ) (if (findfile *PS-OUT*) (vl-file-delete *PS-OUT*) ) ;|Create server script / Crear script servidor|; (setq fp (open *PS-SERVER* "w")) ;|Nombres de los archivos de comunicación|; (write-line "$cmd = $env:TEMP + '\\PL_PS_Command.txt'" fp) (write-line "$out = $env:TEMP + '\\PL_PS_Output.txt'" fp) (write-line "$ouTmp = $env:TEMP + '\\PL_PS_Output.tmp'" fp) (write-line "$ready = $env:TEMP + '\\PL_PS_Ready.txt'" fp) ;|Indicate Powershelll ready / Señalizar que PowerShell está preparado|; (write-line "Set-Content -Path $ready -Value $PID -Encoding Default" fp) ;|Main loop / Bucle principal Powershell remains here for entire session / PowerShell permanece aquí durante toda la sesión|; (write-line "while ($true) {" fp) ;|Is there any pending request? / ¿Hay una orden pendiente?|; (write-line " if (Test-Path $cmd) {" fp) ;|Read ALL code / Leer TODO el código. -Raw permite que PS-EXEC pueda mandar scripts de varias líneas, no solamente una instrucción |; (write-line " $code = Get-Content -Path $cmd -Raw -Encoding Default" fp) ;|Delete request inmediately / Borrar la petición inmediatamente. Esto indica que el servidor ya se ha hecho cargo de ella.|; (write-line " Remove-Item $cmd -Force" fp) ;|Orden para terminar el servidor|; (write-line " if ($code.Trim() -eq '__EXIT__') {" fp) (write-line " break" fp) (write-line " }" fp) ;|Execute code IN THIS POWERSHELL SESSION / Ejecutar código EN ESTA MISMA SESIÓN POWERSHELL|; (write-line " try {" fp) (write-line " $result = Invoke-Expression $code" fp) ;| OUT must always be created so that PS-EXEC knows the process has finished Hay que crear siempre OUT. Incluso si la expresión devuelve $null necesitamos crear el archivo para que PS-EXEC sepa que hemos terminado. |; (write-line " if ($null -eq $result) {" fp) (write-line " Set-Content -Path $ouTmp -Value '' -Encoding Default" fp) (write-line " }" fp) (write-line " else {" fp) (write-line " $result | Out-File -FilePath $ouTmp -Encoding Default" fp) (write-line " }" fp) (write-line " Move-Item $ouTmp $out -Force" fp);rename PL_PS_Output.tmp / renombramos PL_PS_Output.tmp ;|Capturar errores|; (write-line " }" fp) (write-line " catch {" fp) (write-line " ('__ERROR__ ' + $_.Exception.Message) | Out-File -FilePath $out -Encoding Default" fp) (write-line " }" fp) ; close / cerrar 'IF Test-Path' (write-line " }" fp) ;| Sleep / Demorar 10 ms. Prevents resident Powershell instance from continuously using a CPU core while it has nothing to do Evita que el PowerShell residente utilice continuamente un núcleo de CPU mientras no tiene nada que hacer |; (write-line " Start-Sleep -Milliseconds 10" fp) ; cerrar WHILE (write-line "}" fp) ;|PowerShell está terminando|; (write-line "Remove-Item $ready -Force -ErrorAction SilentlyContinue" fp) (close fp) ;|Arrancar PowerShell|; (if (not *PS*) (progn (setq cmd (strcat "powershell.exe " "-NoLogo " "-NoProfile " "-NonInteractive " "-STA " "-ExecutionPolicy Bypass " "-WindowStyle Hidden " "-File \"" *PS-SERVER* "\"" ) sh (vlax-create-object "WScript.Shell") ) (vlax-invoke-method sh 'Run cmd 0 :vlax-false) (vlax-release-object sh) ) ) ;| Esperar a que PowerShell cree READY Máximo: 5 segundos |; (setq n 0) (while (and (not (findfile *PS-READY*)) (< n 500) ) (repeat 10000 (getvar "MILLISECS")) (princ "\rEsperando...") (setq n (1+ n)) ) ;|Result / Resultado|; (if (findfile *PS-READY*) T nil ) ) ) ) (defun PS-EXEC (code / fp lin result t0) ;| Clears any previous result / Borrar posible resultado anterior|; (if (findfile *PS-OUT*) (vl-file-delete *PS-OUT*) ) ;| Write code that Powershell should executed / Escribir el código que debe ejecutar PowerShell|; (setq fp (open *PS-CMD* "w")) (write-line code fp) (close fp) ;|Waiting for a Powershell response / Esperar a que PowerShell responda|; (while (not (findfile *PS-OUT*));(not (findfile *PS-OUT*)) (setq t0 1000) (repeat 1000 (setq t0 (1+ t0))) ) ;|Reading response / Leer respuesta|; (setq fp (open *PS-OUT* "r"));(open *PS-OUT* "r")) (while (setq lin (read-line fp)) (setq result (cons lin result)) ) (close fp) ;| Delete result / Borrar resultado|; (vl-file-delete *PS-OUT*) (reverse result) ) (defun PL-FILEDIALOG-INIT (/ hwnd) ;; HWND de ESTA instancia concreta de AutoCAD (setq hwnd (vla-get-HWND (if (minusp (- (atoi (getvar "ACADVER")) 16)) (vla-get-activeDocument (vlax-get-acad-object)) (vlax-get-acad-object))) ) ;; Windows Forms + OpenFileDialog (PS-EXEC (strcat "Add-Type -AssemblyName System.Windows.Forms;" "$script:f=New-Object System.Windows.Forms.OpenFileDialog" ) ) ;|Small 'wrapper' to convert AutoCAD's HWND into a valid 'IWin32Window' for ShowDialog(owner) Pequeño 'wrapper' para convertir el HWND de AutoCAD en un 'IWin32Window' válido para 'ShowDialog (owner)' |; (PS-EXEC (strcat "Add-Type -TypeDefinition " "'using System;" "using System.Windows.Forms;" "public class WindowWrapper:IWin32Window{" "private IntPtr h;" "public WindowWrapper(IntPtr hwnd){h=hwnd;}" "public IntPtr Handle{get{return h;}}" "}' " "-ReferencedAssemblies System.Windows.Forms" ) ) ;|Locate AutoCAD and create owner Localizar AutoCAD y crear el 'owner' |; (PS-EXEC (strcat "$script:owner=New-Object WindowWrapper(" (itoa hwnd) ")" ) ) T ) (defun pl:getfiledps (title dir ext flg / psquote makefilter code) ;| Escape / Escapar ' PowerShell|; (defun psquote (s / p n) (setq n 0) (while (setq p (vl-string-search "'" s n)) (setq s (strcat (substr s 1 p) "''" (substr s (+ p 2))) n (+ p 2) ) ) s ) (defun makefilter (s / p r x) (setq r "") (while (setq p (vl-string-search ";" s)) (setq x (substr s 1 p) r (strcat r "*." x ";") s (substr s (+ p 2)) ) ) (strcat r "*." s) ) ;|Default values / Valores por defecto|; (if (/= (type title) 'STR) (setq title "Select Files") ) (if (not (and (= (type dir) 'STR) (vl-file-directory-p dir) ) ) (setq dir (getvar "DWGPREFIX")) ) (if (= (type ext) 'STR) (setq ext (makefilter ext)) (setq ext "*.dwg") ) ;| Build only the code needed for this call: Powershell, Forms, f and owner ALREADY EXISTS Construir únicamente el código necesario para ESTA llamada: PowerShell, Forms, f y owner YA EXISTEN |; (setq code (strcat "$script:f.FileName='';" "$script:f.Title='" (psquote title) "';" "$script:f.InitialDirectory='" (psquote dir) "';" "$script:f.Filter='Files (" ext ")|" ext "';" "$script:f.Multiselect=" (if (and (= (type flg) 'INT) (/= flg 0) ) "$true;" "$false;" ) "$r=$script:f.ShowDialog();" "if($r -eq " "[System.Windows.Forms.DialogResult]::OK)" "{$script:f.FileNames}" ) ) ;| Execute in the resident Powershell instance / Ejecutar en PowerShell residente |; (PS-EXEC code) ) ;|If Powershell is not already running, start a instance / SI POWERSHELL NO ESTÁ INSTANCIADO, SE CREA UNA INSTANCIA|; (if (or (not *PS*) (not (findfile *PS-READY*))) (progn (setq *PS* (PS-Start)) (PL-FILEDIALOG-INIT))) ;;;(startapp "notepad" *PS-OUT*) (setq *PS* nil) ;;;(pl:getfiledps "Hola" "c:\\" "dwg" 1) How does it work?... When the code is loaded, a PowerShell instance and a base script are created. After that, simply call the pl:getfiledps function whenever you need it.

Honestly, I've been using AI to code in AutoLISP for the past year or so and I think it's more successful at it than I am. I'm not saying it's clean code, but I'm saying it's already useful. I had a sales engineer ask me info on a project that they're selling trying to verify if what they sold was feasible and with the tool the AI built, I could give them concrete details. If I had to finish that tool, it would have taken me months to write it. I had to test it a bunch of times in autocad and give feedback and it'll find the problem. I had to upgrade which models I used if it gets stuck or restart a new chat. I have a bunch of md files for it to remember how the codebase works but it's getting there. I would say the AI didn't code the whole thing, I still gave it most of the ideas to use, it just had to fill stuff in between for the implementation. At the end of the day, I just want it to work. I had it write a debug.txt which it can read after each test run. I had it create toy functions to measure what it did after the fact. There's a couple of good engineering practices still in place, it's just that I'm allowing myself to have 'fuzzy' details about the implementation.

@GLAVCVS thanks for the feedback. I assume to use a single Powershell session you would have to run a batch file that launches Powershell first before starting autocad? Then when autocad closes or crashes out that session of Powershell also closes.

Yes: as @SLW210 says, it seems to work well. On the other hand: Have you considered having the script written only if it does not already exist in the expected directory, and keeping PowerShell running from the initial load? This would make the dialog box load faster on subsequent calls. In this regard, the script check/creation could be done when the code is loaded. This would also improve the speed of the first execution slightly.

I think AI is definitely part of the reason, but probably not the whole story. A lot of questions that used to become forum threads can now be answered quickly with ChatGPT or Copilot, especially when the problem is a small piece of code or a common error. The interesting part is exactly what you mentioned: when the AI-generated solution fails, people still need somewhere to ask a human who understands the bigger context. AI can produce working-looking code very quickly, but debugging someone else's real project is a different problem. I also think newer users are less attached to forums than they used to be. Many will try a search, ask an AI, or post in a Discord/Reddit community before they ever find a specialist forum. So the drop in posts doesn't necessarily mean people have stopped needing help; the questions may simply be going elsewhere.

Yes you can have custom buttons Ok_Cancel_Width. Have to go back to my R12 paper manual for details.

Professionally all updates are via email. Recorded in the company systems and auditable.

Works great often do old fashioned DOS to get file names list or use the VL files functions. A suggestion remove "result" from the local variables list. As the answer disappears. Or ; Example: ; (setq files (pl:getfiledps "Select Files" (getvar"dwgprefix") "dwg" 1)) A side comment I have used Powershell with Bricscad and sometimes does not work. Your code may help as you do a deeper dive into running Powershell. I generally only do a "Power shell and script" I have used it to change programs, I jump to Excel from CAD.

One observation: in older versions of AutoCAD (2000 and 2002, at least), 'vla-get-HWND' applies to the Document object rather than the Acad object.

The latest version is now in the first post. I used the @BIGAL codes for MS Excel and LibreOffice Calc, all credit given. Hopefully works in non-AutoCAD programs as well, it worked in AutoCAD 2000i on my home computer, batch wasn't an available option, so I may or may not see why. I forgot how much better Calc looks than Excel, it really looked better with my dark theme, I might need to work on my Excel at work. I just used a quickly made Metric drawing, so hopefully everything is correct, I know getting metric measurements in my Imperial drawings is correct. It now has option for the complete report or just the totals. It also gives the actual measurement of a scaled block and the 1:1 total. It also should first ask to save the CSV in the same folder as the drawing now.

Back in the early 90s I had this letter size digitizer tablet by Calcomp called the WIZ. I was able to reduce the typical 12x12 AutoCAD digitizer tablet menu and map it on. Major advantages of this over the typical larger tablets being sold at the time was it's a lot smaller and light weight and cost less too. But after AutoCAD dropped support for DOS and went all out with running on Windows, Calcomp also dropped support for the WIZ and I had to give it up to go with a mouse. I actually wrote about this awhile back in an article I called "What Happened To The Digitizer?"

Watching this whole "AI taking over" debate unfold, I feel like I'm seeing people in our industry fall into three different camps: First, there’s the Spectator. They use AI to generate flashy concept art or write basic emails. It’s pure consumption—cool to look at, but they don't really know how the engine works. Then you have the Skeptical Co-Pilot. This is where I sit for my daily development. You let AI do the heavy lifting for specific, tedious tasks, but you absolutely do not trust it blindly. You sandbox its output and rigorously test it before ever putting it into your actual workflow. Finally, there’s the Blind Believer. This is the whole "AI Agent" crowd trying to run a one-man firm. They type a prompt and expect a flawless final product the next morning. The reality? You have no idea what kind of spaghetti code or geometric garbage is hidden inside that black box, and auditing it takes longer than just doing the work yourself. Speaking of that "skeptical co-pilot" approach, I actually went down a massive rabbit hole with it recently. I was trying to solve a very pragmatic problem: How do we get an LLM to generate hyper-precise CAD geometry without eating up a million tokens and spitting out hallucinated garbage? Natural language just doesn't cut it for drafting. So, I worked with an AI to invent a prototype "Universal Morphological Matrix" (I just call it V-Code). The idea was to strip away all the human linguistic fluff and reduce CAD commands down to an absolute, 256-token hex-based root system. It basically compresses professional CAD knowledge into a tiny "Cosmic Language", which a local interpreter can then unpack back into precise AutoCAD/LISP commands. I pushed the experiment so far that I jokingly asked the AI to use this highly compressed logic to solve the P vs NP math problem. It confidently spit out a bunch of hex codes and claimed it had solved it. Did I believe it? Absolutely not, because I couldn't read its alien derivation track at all, haha! At the end of the day, AI is an incredibly powerful engine. But if you take your hands off the steering wheel and just blindly trust the machine, you're going to crash. It remains a tool exclusively for people who already know exactly what they are doing.

[XDrX-PlugIn(160)] extend or cut curve with circle (theswamp.org) https://www.theswamp.org/index.php?topic=59528.0 Implemented using moving grips(stretch point) (defun c:xdtb_cirextend (/ box clone ints nearpt pnt r ss ss1 strepnts x y z) (xd::doc:getdouble (xdrx-string-multilanguage "\n圆半径" "\nCircle Radius") "#mradius" 10.0 ) (if (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择圆<退出>:" "\nSelect Circle<Exit>:") '((0 . "circle")) ) ) (progn (mapcar '(lambda (x) (setq r (xdrx-getpropertyvalue x "radius") box (xdrx-entity-box x) box (xd::pnts:close box) ) (setq clone (xdrx-object-clone x)) (xdrx-setpropertyvalue x "radius" #mradius) (if (setq ss1 (ssget "f" box '((0 . "*polyline,line")))) (progn (mapcar '(lambda (y) (setq strepnts (xdrx-entity-getstretchpoint y)) (if (setq pnt (vl-some '(lambda (z) (if (xdrx-point-ison z clone) z ) ) strepnts ) ) (progn (if (setq ints (xdrx-entity-intersectwith y x 1)) (progn (setq nearpt (xdrx-points-nearpt pnt ints)) (xdrx-entity-movestretchpointex y pnt (mapcar '- nearpt pnt ) ) ) ) ) ) ) (xdrx-ss->ents ss1) ) ) ) (xdrx-entity-delete clone) ) (xdrx-ss->ents ss) ) ) ) (princ) ) ===================================== The above code uses XDrx API, download link: https://github.com/xdcad/XDrx-API-zip https://sourceforge.net/projects/xdrx-api-zip/ Dual version link: https://github.com/xdcad

Sure. Replace this function. I didn't touch the rest ;; WAMP for Write Area in the Middle of Polyline (defun c:wamp ( / pline ss i hgt clay lay) ;; current layer (setq clay (getvar "CLAYER")) ;; User setting. Set to your liking (setq hgt 2.5) ;; user selects polylines (princ "\nSelect polylines: ") (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;; loop of the elements (setq i 0) (repeat (sslength ss) (setq pline (ssname ss i)) ;; set layer of polyline to current (setvar "CLAYER" (setq lay (cdr (assoc 8 (entget pline)))) ) (wamp pline hgt) (setq i (+ i 1)) ) (setvar "CLAYER" clay) )

I have this with field It work's with entities selection or boundarie (vl-load-com) (defun c:surf_curve-closed ( / AcDoc Space loop js pt_in new_pl area_obj nw_obj ename ent_text dxf_ent key) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) loop T ) (princ "\nSelect a closed object or <Enter/Right-click> for a point in interior of area") (while loop (setq js (ssget "_+.:E:S" '( (-4 . "<OR") (-4 . "<AND") (0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "AND>") (0 . "CIRCLE") (-4 . "<AND") (0 . "SPLINE") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "ELLIPSE") (41 . 0.0) (42 . 6.283185307179586) (-4 . "AND>") (-4 . "OR>") ) ) area_obj nil ) (cond ((null js) (setq pt_in (getpoint "\nGive interior point or <Enter/Right-click> for quit?: ") new_pl (bpoly pt_in nil '(0 0 1)) ) (if (eq (type new_pl) 'ENAME) (setq area_obj (vlax-get-property (setq ename (vlax-ename->vla-object new_pl)) "Area")) (setq loop nil) ) ) (T (setq area_obj (vlax-get-property (setq ename (vlax-ename->vla-object (ssname js 0))) "Area")) ) ) (cond (area_obj (if (zerop (getvar "USERR1")) (setvar "USERR1" (/ (getvar "VIEWSIZE") 75.0))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr3\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (getvar "USERR1") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 256) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) ) (vlax-put (vlax-ename->vla-object (entlast)) 'TextString (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr3\">%" ) ) ) (T (setq loop nil)) ) (princ "\nSelect a closed object or <Enter/Right-click> for a point in interior of area") ) (prin1) )

I started from scratch. Is this how you want is? Bottom function: adapt the text height to your likings . Now: (setq hgt 2.5) ;;1. promt the user to select multiple polygons. ;;2. in a loop: ;; a. calculate each polygon area. ;; b. insert the area text in the geometric center of each polygon (vl-load-com) ;; Multiple assoc. Returns a list of all requested (assoc) with set key ; use like this (massoc 10 YourListOfData) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; main function (defun wamp (pline hgt / area pt str vert_pts x y p) (setq area (vla-get-area (vlax-ename->vla-object pline) )) ;; get the vertex positions. (setq vert_pts (massoc 10 (entget pline))) (setq x 0.0) (setq y 0.0) ;; Then calculate the average. Sum of x and y values divided by the number of vertices (foreach p vert_pts (setq x (+ x (nth 0 p))) (setq y (+ y (nth 1 p))) ) (setq pt (list (/ x (length vert_pts)) (/ y (length vert_pts)) )) ;; make a string out of the area float. Here would be the place to add a prefix or postfix. Example: ;; (setq str (strcat "area: " (rtos area 2 3) )) (setq str (rtos area 2 3)) ;; that 3 means 3 decimals. Feel free to change this (drawText pt hgt str) (princ ) ) ;; WAMP for Write Area in the Middle of Polyline (defun c:wamp ( / pline ss i hgt) ;; User setting. Set to your liking (setq hgt 2.5) ;; user selects polylines (princ "\nSelect polylines: ") (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;; loop of the elements (setq i 0) (repeat (sslength ss) (setq pline (ssname ss i)) (wamp pline hgt) (setq i (+ i 1)) ) )