Leaderboard
Popular Content
Showing content with the highest reputation on 09/17/2025 in Posts
-
1 point
-
As @BIGAL says, I think Claude is suggesting you unnecessary code. I've modified my previous code to create a loop. I've also simplified and fixed a small loophole in the logic of the 'DefMTextJustification' function. (defun c:LE-CalExtFFL ( / pt1 pt2 pt3 r TxtRotation TxtJustification radians degrees ecoA para) (setq ecoA (getvar "CMDECHO")) (setvar "CMDECHO" 0) (vla-startUndomark (vla-get-activeDocument (vlax-get-acad-object))) (command "_layer" "_m" "-LE-E-External Levels" "") (setq Prefix "") (setq Suffix "") (while (and (not para) (setq ffl-ent (car (entsel))) (= (cdr (assoc 0 (entget ffl-ent))) "MTEXT") ) (if (setq r (vl-catch-all-apply '(lambda () ;; Get the MText object and extract text content (setq ffl-obj (entget ffl-ent)) (setq ffl-text (cdr (assoc 1 ffl-obj))) (princ (strcat "\nFFL Text found: " ffl-text)) (setq ffl-value (ExtractFFLValue ffl-text)) (princ "\nSelect points where to place the level text (Press Enter to finish): ") (if ffl-value (if (setq pt1 (getpoint "\nSelect first point: ")) (if (setq pt2 (getpoint pt1 "\nSelect second point: ")) (virtualiza) ) ) ) ) ) ) (setq para T) ) ) (if r (entdel (entlast))) (setvar "CMDECHO" ecoA) (princ) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (defun virtualiza (/ para grd mto) (princ "\nMove the mouse to decide justification (escape to CANCEL)...") (while (and (not para) (setq grd (grread nil 13 0)) (listp (cadr grd))) (setq pt3 (cadr grd)) (setq SpotLevel (- ffl-value 0.15)) ;; Initialize point list ;; Prompt for points where to place the new MText (setq TxtRotation (angle pt1 pt2)) (setq TxtValue SpotLevel) (DefMTextJustification pt1 pt2 pt3) (if mto (entmod (subst (cons 71 TxtJustification) (assoc 71 (entget mto)) (entget mto))) (setq mto (CreateMText pt1 TxtValue TxtRotation TxtJustification) ) ) (if (= (car grd) 3) (setq para T)) ) (vla-EndUndomark (vla-get-activeDocument (vlax-get-acad-object))) ) (defun ExtractFFLValue (text-string / clean-text) (if (> (strlen text-string) 5) ;Charcters Removed from String (setq clean-text (substr text-string 6)) (setq clean-text text-string) ) (if (numberp (read clean-text)) (read clean-text) (progn (vlr-beep-reaction) (princ "\n*** ERROR : Could not extract numeric value from FFL text ***") nil ) ) ) (defun DefMTextJustification ( p1 p2 p3 / ) ;; Top Left = 1 ;; Top Center = 2 ;; Top Right = 3 ;; Middle Left = 4 ;; Middle Center = 5 ;; Middle Right = 6 ;; Bottom Left = 7 ;; Bottom Center = 8 ;; Bottom Right = 9 (if (or (and (>= (angle p1 p2) 0.0) (<= (angle p1 p2) (/ PI 2.))) (>= (angle p1 p2) (/ (* 3. PI) 2.)) ) (progn (setq Prefix "+") (setq Suffix "") (if (= (asr p1 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (/ PI 2.)) 1) nil) p3) -) (setq TxtJustification 1) (setq TxtJustification 7) ) ) (progn (setq Prefix "") (setq Suffix "+") (setq TxtRotation (+ TxtRotation pi)) (if (= (asr p1 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (/ PI 2.)) 1) nil) p3) +) (setq TxtJustification 3) (setq TxtJustification 9) ) ) ) ) (defun CreateMText ( point txtvalue txtrot txtjust / txtjust txtrot mtext-obj) (setq mtext-obj (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 8 (getvar "CLAYER")) ; Current layer (cons 100 "AcDbMText") (cons 10 point) ; Insertion point (cons 40 0.5) ; Text height (adjust as needed) (cons 41 0.0) ; Reference rectangle width (cons 71 txtjust) (cons 72 5) ; Drawing direction (cons 1 (strcat Prefix (rtos txtvalue 2 3) Suffix)) ; Text content with "+" prefix (cons 50 txtrot) ; Rotation angle ) ) ) mtext-obj )1 point
-
I think you've solved the problem very well. In response to your request for improvements or suggestions, I've provided some minor modifications below that, in my opinion, make the command more intuitive. (defun c:LE-CalExtFFL ( / pt1 pt2 pt3 r TxtRotation TxtJustification radians degrees ecoA) (setq ecoA (getvar "CMDECHO")) (setvar "CMDECHO" 0) (vla-startUndomark (vla-get-activeDocument (vlax-get-acad-object))) (command "_layer" "_m" "-LE-E-External Levels" "") (setq Prefix "") (setq Suffix "") (setq ffl-ent (car (entsel))) (if (and ffl-ent (= (cdr (assoc 0 (entget ffl-ent))) "MTEXT")) (setq r (vl-catch-all-apply '(lambda () ;; Get the MText object and extract text content (setq ffl-obj (entget ffl-ent)) (setq ffl-text (cdr (assoc 1 ffl-obj))) (princ (strcat "\nFFL Text found: " ffl-text)) (setq ffl-value (ExtractFFLValue ffl-text)) (princ "\nSelect points where to place the level text (Press Enter to finish): ") (if ffl-value (if (setq pt1 (getpoint "\nSelect first point: ")) (if (setq pt2 (getpoint pt1 "\nSelect second point: ")) (virtualiza) ) ) ) ) ) ) ) (if r (entdel (entlast))) (setvar "CMDECHO" ecoA) (princ) ) (defun virtualiza (/ para grd mto) (princ "\nMove the mouse to decide justification (escape to CANCEL)...") (while (and (not para) (setq grd (grread nil 13 0)) (listp (cadr grd))) (setq pt3 (cadr grd)) (setq SpotLevel (- ffl-value 0.15)) ;; Initialize point list ;; Prompt for points where to place the new MText (setq TxtRotation (angle pt1 pt2)) (setq TxtValue SpotLevel) (DefMTextJustification pt1 pt2 pt3) (if mto (entmod (subst (cons 71 TxtJustification) (assoc 71 (entget mto)) (entget mto))) (setq mto (CreateMText pt1 TxtValue TxtRotation TxtJustification)) ) (if (= (car grd) 3) (setq para T)) ) (vla-EndUndomark (vla-get-activeDocument (vlax-get-acad-object))) ) (defun ExtractFFLValue (text-string / clean-text) (if (> (strlen text-string) 5) ;Charcters Removed from String (setq clean-text (substr text-string 6)) (setq clean-text text-string) ) (if (numberp (read clean-text)) (read clean-text) (progn (princ "\nError: Could not extract numeric value from FFL text.") nil ) ) ) (defun DefMTextJustification ( p1 p2 p3 / ) ;; Top Left = 1 ;; Top Center = 2 ;; Top Right = 3 ;; Middle Left = 4 ;; Middle Center = 5 ;; Middle Right = 6 ;; Bottom Left = 7 ;; Bottom Center = 8 ;; Bottom Right = 9 (if (or (and (>= (angle p1 p2) 0.0) (<= (angle p1 p2) (/ PI 2.))) (>= (angle p1 p2) (/ (* 3. PI) 2.))) (progn (setq TxtJustification 1) (setq Prefix "+") (setq Suffix "") (if (> (angle p1 p3) (angle p1 p2)) (progn (setq TxtJustification 7) (setq Prefix "+") (setq Suffix "") (if (and (= (angle p1 p2) 0.0) (> (angle p1 p3) 4.71238898)) (progn (setq TxtJustification 1) (setq Prefix "+") (setq Suffix "") ) ) ) ) ) (progn (setq TxtJustification 3) (setq Prefix "") (setq Suffix "+") (setq TxtRotation (+ TxtRotation pi)) ;;Set Justification to Bottom (if (> (angle p1 p3) (angle p1 p2)) (progn (setq TxtJustification 3) (setq Prefix "") (setq Suffix "+") ) (progn (setq TxtJustification 9) (setq Prefix "") (setq Suffix "+") ) ) ) ) ) (defun CreateMText ( point txtvalue txtrot txtjust / txtjust txtrot mtext-obj) (setq mtext-obj (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 8 (getvar "CLAYER")) ; Current layer (cons 100 "AcDbMText") (cons 10 point) ; Insertion point (cons 40 0.5) ; Text height (adjust as needed) (cons 41 0.0) ; Reference rectangle width (cons 71 txtjust) (cons 72 5) ; Drawing direction (cons 1 (strcat Prefix (rtos txtvalue 2 3) Suffix)) ; Text content with "+" prefix (cons 50 txtrot) ; Rotation angle ) ) ) mtext-obj )1 point
-
(vl-load-com) (defun c:FOO (/ *error* acDoc ss pt y item data blocks) (defun *error* (msg) (if ss (vla-delete ss)) (if acDoc (vla-endundomark acDoc)) (cond ((not msg)) ; Normal exit ((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit) ((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it ) (princ) ) (if (and (ssget "_:L" '((0 . "INSERT"))) (setq d (getreal "\nEnter Block distance: ")) ) (progn (vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object))) ) (vlax-for x (setq ss (vla-get-activeselectionset acDoc)) (setq pt (vlax-get x 'insertionpoint)) (if (setq item (assoc (setq y (cadr pt)) data)) (setq data (subst (cons (car item) (append (cdr item) (list x))) item data) ) (setq data (cons (cons y (list x)) data)) ) ) (if data (foreach item data (setq blocks (vl-sort (cdr item) (function (lambda (a b) (< (car (vlax-get a 'insertionpoint)) (car (vlax-get b 'insertionpoint)) ) ) ) ) ) (setq pt (vlax-get (car blocks) 'insertionpoint)) (foreach block (cdr blocks) (vla-move block (vlax-3d-point (vlax-get block 'insertionpoint)) (vlax-3d-point (setq pt (polar pt 0.0 d))) ) ) ) ) ) ) (*error* nil) ) This works for each group of Blocks at a given Y level, based on the lowest X position in a given row as starting point.1 point