Function to calculate Mtext Justification based on Rotation

[Tsuky]

@CivilTechSource

Quote

I suppose the next to improve it is add offset, or a settings menu?

It's easy to do that.

I have make a more robust filter for mtext (with your exemple, adjust if necessary) 

(defun q_ang (alpha / )
  (cond
    ((not (eq (rem alpha (* 1.5 pi)) alpha)) 4)
    ((not (eq (rem alpha pi) alpha)) 3)
    ((not (eq (rem alpha (* 0.5 pi)) alpha)) 2)
    (T 1)
  )
)
(defun c:wow ( / ss ent dxf_ent ptlst n pt_cen dir_ang tmp ofst n rot)
  (princ "\nSelect closed polylines")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&") (70 . 1))))
  (cond
    (ss
      (initget 4)
      (setq
        ent (ssname ss 0)
        dxf_ent (entget ent)
        ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
        n (float (length ptlst))
        pt_cen (list (/ (apply '+ (mapcar 'car ptlst)) n) (/ (apply '+ (mapcar 'cadr ptlst)) n))
        dir_ang (mapcar 'q_ang (mapcar '(lambda (x) (angle pt_cen x)) ptlst))
        tmp (* (distance pt_cen (car ptlst)) 0.25)
        ofst (getdist (car ptlst) (strcat "\nOffset for text <" (rtos (getvar "TEXTSIZE")) ">?: "))
      )
      (if (not ofst) (setq ofst (getvar "TEXTSIZE")))
      (mapcar
        '(lambda (p d / j po)
          (setq qsel (ssget "_C" (mapcar '- p (list tmp tmp 0.0)) (mapcar '+ p (list tmp tmp 0.0)) '((0 . "MTEXT") (8 . "-LE-E-External Levels") (7 . "LE Standard (No Height)"))))
          (cond
            (qsel
              (repeat (setq n (sslength qsel))
                (setq
                  ent (ssname qsel (setq n (1- n)))
                  dxf_ent (entget ent)
                  rot (cdr (assoc 50 dxf_ent))
                )
                (if (eq d 1) (if (zerop rot) (setq j 9 po (polar p (* 0.5 pi) ofst)) (setq j 7 po (polar p 0.0 ofst))))
                (if (eq d 2) (if (zerop rot) (setq j 7 po (polar p (* 0.5 pi) ofst)) (setq j 1 po (polar p pi ofst))))
                (if (eq d 3) (if (zerop rot) (setq j 1 po (polar p (* 1.5 pi) ofst)) (setq j 7 po (polar p pi ofst))))
                (if (eq d 4) (if (zerop rot) (setq j 3 po (polar p (* 1.5 pi) ofst)) (setq j 1 po (polar p 0.0 ofst))))
                (setq dxf_ent (subst (cons 10 po) (assoc 10 dxf_ent) dxf_ent))
                (setq dxf_ent (subst (cons 71 j) (assoc 71 dxf_ent) dxf_ent))
                (entmod dxf_ent)
              )
            )
          )
        )
        ptlst dir_ang
      )
    )
  )
  (prin1)
)

 

[GLAVCVS]

One step further could be to increase or decrease the size of the MTEXT objects.
This could be done dynamically, giving meaning to the cursor movement: when it moves in a certain direction, it not only determines the justification but also, as it moves farther away, it gradually increases the size step by step.
In my opinion, this is an interesting idea that deserves to be explored.

[GLAVCVS]

On 9/18/2025 at 9:06 AM, GLAVCVS said:

One step further could be to increase or decrease the size of the MTEXT objects.
This could be done dynamically, giving meaning to the cursor movement: when it moves in a certain direction, it not only determines the justification but also, as it moves farther away, it gradually increases the size step by step.
In my opinion, this is an interesting idea that deserves to be explored.

 

A relatively simple approach

 

 

 

 

[GLAVCVS]

(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 (progn (entdel (entlast)) (princ "\r")))
  (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 txJA d a1 a ejp1 ejp2 pandora color pt)
  (while (and (not para) (setq grd (grread nil 13 0)) (or (listp (cadr grd)) (= (car grd) 2)))
    (princ "\rMove the mouse to decide Justification and change Height, press < C > to change color, < + > or < - > to increase or decrease offset or press ESCAPE to cancel) ")
    (if (= (car grd) 2)
      (cond
	((member (cadr grd) '(67 99)) (setq color (acad_colorDLG 1 T)))
	((member (cadr grd) '(43 45)) ;|+ o -|; (vla-put-InsertionPoint (vlax-ename->vla-object mto) (vlax-3d-point (setq pt (polar (if pt pt pt1) ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) ((if (= (cadr grd) 43) + -) 0.1))))))
      )
      (progn	
        (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
          (if (/= TxtJustification txJA)
            (entmod (subst (cons 71 (setq txJA TxtJustification)) (assoc 71 (entget mto)) (entget mto)))
          )
          (setq mto (CreateMText pt1 TxtValue TxtRotation (setq txJA TxtJustification)) a (cdr (assoc 40 (entget mto))))
        )
        (setq a (cdr (assoc 40 (entget mto)))
	      ejp1 (polar pt1 ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) (/ a 2.))
	      ejp2 (polar pt2 ((if (member txJA '(1 3)) - +) (angle pt1 pt2) (/ PI 2.)) (/ a 2.))
        )
        (if (= (car grd) 3) (setq para T))
        (cond
          ((> (setq d (distance (cadr grd) (setq ppp (inters ejp1 ejp2 (cadr grd) (polar (cadr grd) (+ (angle pt1 pt2) (/ PI 2.)) 1) nil)))) (* a (if pandora 1. 2.)))
           (setq d (/ d 2.)
	         a1 (if (< (setq a1 (/ (fix (* d 10)) 10.)) 0.1) 0.1 a1)
           )
	   (entmod (append (entget mto) (if color (list (cons 40 a1) (cons 62 color)) (list (cons 40 a1)))))
           (setq pandora T)
           (princ (strcat "  << Current Size: " (rtos a1 2 1) " >>"))
          )
          (pandora
           (setq d (/ d 2.)
	         a1 (if (< (setq a1 (/ (fix (* d 10)) 10.)) 0.1) 0.1 a1)
           )
	   (entmod (append (entget mto) (if color (list (cons 40 a1) (cons 62 color)) (list (cons 40 a1)))))
           (princ (strcat "  << Current Size: " (rtos a1 2 1) " >>"))
	  )
        )
      )
    )  
  )
  (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 / p)
  ;; 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
  (setq p1 (polar p1 (angle p2 p1) 1e8))
  (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
)