Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation since 10/07/2026 in Posts

  1. 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...
    3 points
  2. 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
    3 points
  3. 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.
    2 points
  4. @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
    2 points
  5. 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") ) )
    2 points
  6. Have you tried: https://www.lee-mac.com/associativecenterlines.html ?
    2 points
  7. @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)
    2 points
  8. @Steven P So it is "APPLOAD" - meaning the lisps files are loaded on startup, not as "autoload" that only load the lisp the first time you type the command - load on demand? and can you save this "startup suit" to a file and use it on other computer or you must do it manually on a new machine?
    1 point
  9. In detailed engineering drawings, hatching can become frustrating when boundaries contain many small edges, gaps, or overlapping objects. A hatch may fail to generate, fill an unintended area, or become difficult to edit after the geometry changes. Increasing the gap tolerance can sometimes help, but it may also cause the hatch to cross boundaries that should remain closed. How do you troubleshoot hatch problems in drawings with complex boundaries? Do you repair the geometry first or use a different hatching approach?
    1 point
  10. Just type Appload in Bricscad, you will ser the "Load Application Files" click on "Autoload" and the lisp entry will be loaded on startup.
    1 point
  11. That makes sense! Keeping Properties open is definitely more convenient when checking and changing values repeatedly. I guess LIST is still useful when you want a quick text-based report of an entity, but Properties is more practical for everyday editing.
    1 point
  12. FYI, I used to run the LIST command quite a bit to give me information about the object(s) in question. But with the introduction of the Properties command in AutoCAD 2000, I slowly got used to leaving the Properties window opened/docked in the drawing area. Then as an object is selected, it's "properties" would automatically be filled out for me to inspect inside the Properties window. There's no need to run an extra command sequence like the LIST command which then would have to display the information on on a separate Text screen. In addition, the Properties window makes it possible for you to enter new values into those property items that can be modified.
    1 point
  13. @Steven P yes email a lsp and a ZIP file, with all the other stuff MNU CUIX lisp's dwg's dwt's etc. If using a server based solution then don't need a ZIP. One thing I did look at was making a custom CUI & CUIX file, they are xml files the later zipped and named CUIX. As mentioned before copy a CUIX rename to zip and have a look inside. Was looking at using Excel to write the menu then convert to XML code -> CUI, CUIX. For a custom mnu just need to work out how to write the XML code. Avoiding the CUI command. @VicoWang maybe have a look at making a CUI would be very helpful.
    1 point
  14. Some times with very odd shaped boundaries AutoCAD just has a hard time filling it with any hatch pattern. That's when I would break the single hatch area up into different area sections. The boundary would be drawn using a PLINE and placed onto a non-plot layer. This usually resolves the issue. Another solution that worked for me involves odd shaped boundaries that are symmetrical. The hatch area when broken up in half hatches perfectly on the left side but refuse to hatch properly on the right. So I would just create the hatch pattern on the side that works and then mirrored that to the other side.
    1 point
  15. As I state in the header, I found the AutoCAD dimension "MARK" to be less than useful, so over the years I have used my own, eventually writing some LISP, as well as having found the mentioned LISP by alanjt. I really don't care for mucking around with the new CENTERMARK either. Thought I might as well share it, some may find it handy. ;;; Replace Diameter/Radius dimension CenterMarks with two CENTER2 linetype lines. ;;; ;;; https://www.cadtutor.net/forum/topic/99350-center-mark-replacement/#findComment-680408 ;;; ;;; By SLW210 (a.k.a. Steve Wilson) ;;; ;;;| Since AutoCAD in there infinite wisdom makes the default dimdia and dimrad center marks useless by not allowing them to be associated by other dimensions and not allowing an individual color and linetype I came up with this little routine. Much faster, it was using some commands, I went to removing commands. I used to get rid of the default the drew a centermark and copied from center to center, a bit tedious at best. I started with this from Alan J Thompson, so thanks to him. ================================================================ Turn off the centermark for diameter and radius dimensions https://www.cadtutor.net/forum/topic/18792-request-routint-to-turn-off-center-mark-for-single-entity/#findComment-153451 By alanjt|; ;;; ;;; ================================================================ ;;; ================================================================ ;;; CtrMrkRep.lsp ;;; ;;; Replace Diameter/Radius dimension center marks with ;;; two CENTER2 linetype lines. ;;; ;;; ;;; AutoCAD 2018-2026 should work as well as BricsCAD and others. ;;; ;;; ================================================================ ;;; ================================================================ ;;; Original dimensions are retained. ;;; ;;; Replacement geometry: ;;; Layer : CenterMark ;;; Color : ByLayer ;;; Linetype : ByLayer ;;; Layer Color : ACI 5 (Blue) ;;; Layer Linetype : CENTER2 ;;; ;;; Modes: ;;; Select - manually selected DIMDIAMETER/DIMRADIUS ;;; Current - all such dimensions in current Model/Layout space ;;; All - all such dimensions in all paperspace layouts ;;; ;;; Associated dimension center marks: ;;; Disabled using ActiveX acCenterNone. ;;; ;;; Duplicate centers: ;;; Only one centerline cross is created for each unique center ;;; within each Model/Layout space. ;;; ================================================================ CtrMrkRep.lsp
    1 point
  16. When I run into a situation like this, the complexity or the effort can become too much, especially if there's a deadline. In that case I'll draw a polyline along the border and use that as the boundary for the hatch. Of course the polyline goes on a nonplotting layer.
    1 point
  17. Still looking into this the reason being is that if you put your notes into Word you can auto number, then bring back into CAD, you can add or remove a note and they will auto renumber saving a lot of time and no need to say run a program over the notes again. Used in Autocad and Bricscad. I have hit a stumbling block in trying to make a True type font. If you want numbers then can have 1-52 as paragraph numbers, the trick is can use A-Z & a-z in MS-Word copy into cad these will be seen as numbers in a hexagon 1-52. I did find a Hexagon TTF 1-9 A-Z but my Bricscad does not support a version 1xxx TTF, needs a version 2xxx. I have been going around in circles trying to use Inkscape to make a vector file then Fontforge to make the TTF. So if any one is out there and has used Fontforge to make a TTF would appreciate some help. I have a lisp to generate individual output dwg, dxf or PDF.
    1 point
  18. @BIGAL I just want to add more detail to @VicoWang explanation. To begin with, I would like to point out that I have over 11 apps all written in AutoLISP & DCL. When installed successfully the added commands from a typical app are presented with the loading of a partial menu which adds a panel under the Add-ins section of the Ribbon along with Toolbar so the end user knows exactly where to go to access the added commands. Prior to VedaCAD, these apps are all marketed on the Autodesk app store which is now called Design and Make Marketplace. Autodesk has a set a fairly vigorous review standards that must be met in order for a third party app to qualify in their app store. In additional, as a developer, you would have to submit everything to them to generate the msi setup file for user download and installation. This submittal for review process can take a number of weeks to approve before your app can go live on their app store. But then enters VedaCAD. I now can use the VC vlx app to create my own installation bundle without a need to submit my files to another company to review for approval. There's also no need for an msi setup file but instead all that is needed is the VC ID code that references that bundle on the VedaCAD server for complete installation. After the end user loads the VC .vlx app, all that is required is to import that VC ID code and my app is now installed exactly like it is using msi setup file. But the difference with VedaCAD is that the end user must now always load the VC.vlx file in order to have access to the added app. Hope this clarifies a bit more as to what VedaCAD does for you.
    1 point
  19. I am still confused, yes I have around 150 lisps behind 3 pop menu's, and the idea of being simply able to find them I understand, but from a dumb user perspective how do I know how to call up a Lisp program, despite numerous post I still don't see how to call the lisps. There is no way where I worked in a team environment they would know the name of a lisp or a command that ran it. They would just walk away. @VicoWang Maybe show your CAD setup.
    1 point
  20. @aridzv not sure why your not using a custom Pop menu, Toolbar or Ribbon, then you can demand load any lisp no need to preload lisps. Yes one of my custom POP menus has 130 lisps behind it. I used to run 3 custom menu's. Yes a Startuplisp as well. I have a Word doc "How to make a pop menu"How to make POP menu.docx Part 2 I have a install lisp it uses a zip file of all relevant files and it is un zipped via lisp to correct directory, support paths added, new menu's added. If you look into Regedit you can find the appload list in the registry and change it.
    1 point
  21. Would going down the dynamic block be a way to always get a Cross at center point of a fixed size then adjust the 4xdistance on the quad legs. Would need a gap distance in the block as say fixed also. I am not the best at dynamic blocks maybe some one else can try it. Using a lisp allows the working out of all the distance parameters and reset them. This would be repeated 4 times. can use D2=D1 and so on. Just did a linear constraint. Trying to remember how to d2=d1.
    1 point
  22. Thank you for the reference, I made the Multi getval lisps as had so many lisp's that asked for a value after a value then realise have typed one wrong. Also set default values. The approach being can use in any code, the multi radio buttons being a replace for the Initget function. There are versions like one column or two or even three. Something still on the back burner is write a lisp/dcl code based on dwg objects. Have started.
    1 point
  23. As a "tangent" (pun intended) I really like the CENTERLINE command. I think it's extremely useful how the associativity is made and stays.
    1 point
  24. Sure, I know what you mean. I have my own routine i spun years ago that i still use. i use a linetype scale ratio to keep the center with a single set of gaps and centermark. Although it's not perfect, it's good enough for me.
    1 point
  25. I know of that one, but my LISP replaces the centermarks for dimdiameter and dimradius, by selection, by current or all. I could possibly add reactors to mine, not sure it's necessary.
    1 point
  26. When you mention dimension mark I assume you’re referring to AutoCADs original DIMCENTER command which I agree is quite useless. But I do think the number of commands beginning with the word center introduced back in 2017 were a lot more useful since finally the “marks” can now be made associatively to the objects selected.
    1 point
  27. I followed this method as well. I avoid using surfaces whenever possible due to problems (sometimes) with converting them to solids.
    1 point
  28. I doubt if this has anything to do with AutoCAD, usually if the print preview is correct it goes to something past AutoCAD. Autodesk site recommends changing the "Capture fonts used in the drawing" to "Convert all text to geometry" for PDF specific font issues, is this an option for you? Did you try some of the other PDF plotters, full AutoCAD has a few more, I would think LT does as well? Did this start after a Windows update or the AutoCAD update?
    1 point
  29. 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!
    1 point
  30. 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.
    1 point
  31. On a separate note, do you think there is a way to place the hexagon for multi-line paragraphs in between the 1st/2nd lines of that paragraph, and keep the single-line hexagons centered of course?
    1 point
  32. We had our notes originally in word so it would put a paragraph number in it automatically. We pasted that word doc into CAD the advantage was if a paragraph was removed it would renumber the notes. I have used a True type font to put numbers in a circle. May see if can find a hexagon one. Ok we had a multiple font add on that you typed "a" and a stop sign appeared it was a Font where each character representing a road sign had been made. I have previously looked at a "Make TTF's" So you could make hexagons with a number. This is 1234567890 Part two a edited mtext of two fonts. Had a play in word and sort of got something, Will see if there is a TTF out there. This was a manual edit of a mtext, Changed 1 2 3 4 so its doable. I did search for "hexagon TTF with numbers inside" and yes found a couple of answers. You may be able to use a SHX file will look into that also.
    1 point
  33. 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) )
    1 point
  34. hello @dber I get what you're after — numbered construction notes with a hexagon bubble, text wrapping at a fixed column width. I can put a LISP together for you. Just answer these and I'll build it — letters are fine: 1. Where does the text come from? a) I type it in as I go b) it's already scattered in the drawing c) I paste it from Word or Excel 2. If it's already in the drawing, what is it? a) TEXT b) MTEXT c) not sure / it's mixed 3. How are the notes split up? a) one text object per note b) all in one MTEXT, one paragraph per note c) not sure 4. Is the number already written into the text? a) yes, like "1. Pour slab..." b) no, it needs to be added c) some yes, some no 5. Does the hexagon already exist? a) yes b) no, it needs to be created 6. If it exists, what is it? a) a block with an attribute for the number b) a block with no attribute (number sits separately) c) loose geometry, just lines d) not sure 7. Column width? a) I'll pick it in the drawing b) I'll give you a number 8. Does the text have hard line breaks already in it? a) yes, keep them b) yes, strip them and let it wrap on its own c) no 9. Where do the notes go? a) model space b) layout / paper space Answer those and I'll know exactly what to write.
    1 point
  35. Yep an easy solution, if you make a block with an attribute of mtext, so can be one or more lines. You insert the block, add attribute value. You can adjust the insertion point of the mtext attribute, via lisp (vlax-put attobj 'insertionpoint (list 10 5)). You can control the text pt to be say even with top, mid aligned, bottom aligned and so on even to left or right. In image I just made a simple block with a single attribute. If you dont know how to write a lisp for the task just ask. You may need to use "Bounding box" on the attribute to work out its corners or mid points and so on. Can use my Multi radio buttons.lsp to select alignment . The Multi radio buttons 2 col.lsp may be useful for a advanced version of moving attribute.
    1 point
×
×
  • Create New...