Function to calculate Mtext Justification based on Rotation

[CivilTechSource]

Hi,

This might have been resolved before. But has anyone wrote a lisp or function that calculates the text anchor point based on the rotation of the text?

Currently I have a lisp that will prompt the user to select FFL and then will calculate 150mm drop and prompt the user to select point to insert the text and second point to specify angle. I want to push it a step further and add a function to calculate the correct text anchor point which this should be done using the angle (i.e. if pt1X > pt2X & pt1Y>pt2Y then MtextJustify=BottomLeft).

I appreciate that when Angle is 0 or 180 the justification in regards to Top & Bottom (Ignoring Left or Right) cannot be calculate due to the angle being zero, which I dont mind.

 

See Lisp code below

(defun c:LE-CalExtFFL (/ ffl-ent ffl-obj ffl-text ffl-value new-level pt-list pt user-input)
  ;;Set Layer
  (command "_layer" "_m" "-LE-E-External Levels" "")
  
  ;; Function to extract numeric value from FFL text
  (defun extract-ffl-value (text-string / clean-text)
    ;; Remove first 5 characters from the string
    (if (> (strlen text-string) 5)
      (setq clean-text (substr text-string 6))
      (setq clean-text text-string)
    )
    ;; Extract the numeric value
    (if (numberp (read clean-text))
      (read clean-text)
      (progn
        (princ "\nError: Could not extract numeric value from FFL text.")
        nil
      )
    )
  )
  
  ;; Function to create MText at specified point
  (defun create-level-mtext (point level-value rot / mtext-obj)
    ;Calculate Attachment Point based on rotation
    


    ;Place Text
    (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 1)                 ; Attachment point (top left)
          (cons 72 5)                 ; Drawing direction
          (cons 1 (strcat "+" (rtos level-value 2 3)))  ; Text content with "+" prefix
          (cons 50 rot)               ; Rotation angle
        )
      )
    )
    mtext-obj
  )

  ;;Main program starts here------------------------------------------
  ;; Prompt user to select FFL MText
  (princ "\nSelect the MText containing the FFL (Finished Floor Level): ")
  (setq ffl-ent (car (entsel)))
  ;; Check if a valid MText was selected
  (if (and ffl-ent 
           (= (cdr (assoc 0 (entget ffl-ent))) "MTEXT"))
    (progn
      ;; 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))
      ;; Extract the FFL numeric value
      (setq ffl-value (extract-ffl-value ffl-text))
      (if ffl-value
        (progn
          (setq new-level (- ffl-value 0.15))
          ;; Initialize point list
          (setq pt-list '())
          ;; Prompt for points where to place the new MText
          (princ "\nSelect points where to place the level text (Press Enter to finish): ")
          ;; Loop to collect points
          (while (setq pt (getpoint "\nPick point for level text (or press Enter to finish): "))
            (setq pt-list (append pt-list (list pt)))
            (setq rotation (getangle pt "\nSpecify rotation angle for text (or press Enter for 0 degrees): "))
            (if (not rotation) (setq rotation 0.0))
            
            (create-level-mtext pt new-level rotation)
          )
        )
        (princ "\nCould not extract FFL value from the selected text.")
      )
    )
    (princ "\nError: Please select a valid MText object containing FFL information.")
  )
  (princ) ; Clean exit
)

 

CTS-Example Anchor Point.dwg