Jump to content

Leaderboard

Popular Content

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

  1. Have you tried: https://www.lee-mac.com/associativecenterlines.html ?
    2 points
  2. 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
  3. 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") ) )
    1 point
  4. 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
  5. 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
  6. I followed this method as well. I avoid using surfaces whenever possible due to problems (sometimes) with converting them to solids.
    1 point
  7. 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
  8. 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
  9. 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
  10. 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
    1 point
  11. You already have a thread on this topic. Stop creating the same threads over and over, please. I have already had to delete some threads you already had previously posted. You look more and more like a bot or spammer. Not sure what you are up to with all of this, everything seems copy and paste over and over. Title: Why can a LOFT create a twisted 3D shape even when the profiles look correct? - AutoCAD 3D Modelling & Rendering - AutoCAD Forums
    1 point
  12. Pick to right of + sign use "Begin/end select" is what I do, though I don't use Notepad++ very much. The CTRL+ALT+b is pretty easy for me if I am using a right-hand mouse, like Daniel I would have to figure out a good shortcut if using a mouse left-handed. I used to use a lot of custom shortcuts/ inputs, but at one point I was working on various computers doing things and would have a "brain freeze" trying to figure out how it was normally done on some things so got out of the habit. Now I don't really do much that's not on one of my computers or work computer, though occasionally I get an email or call on how to do something, so probably a good time to go back to using shortcuts. Not sure what everybody else has, but my MS VS Code, I just select just inside a bracket and double-click to select all between the related brackets.
    1 point
  13. We basically used our DWT so would insert an external dwg then way more than units were correct. The only disclaimer is that most of our dwg's started off with "Model" only no layouts. Our design process created those.
    1 point
  14. 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.
    1 point
  15. 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.
    1 point
  16. It may now look like a "Medion Design USB Graphics pad". Yes did get it to work with CAD but went back to a mouse, I dont do enough true drafting to really get into using it. Maybe Win 10.
    1 point
×
×
  • Create New...