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

[mhupp]

This would create a text with top left just if the rotation angle is between 0 and 180 else it will be Bottom left.

 

(defun create-level-mtext (pt1 rot / mtext-obj)
  (if (and rot (> rot 0) (< rot pi)) ;check rotation angle
    (setq x 1)
    (Setq x 7)
  )
  (setq mtext-obj
    (entmakex 
      (list
        (cons 0 "MTEXT")
        (cons 100 "AcDbEntity")
        (cons 8 (getvar "CLAYER"))  ; Current layer
        (cons 100 "AcDbMText")
        (cons 10 pt1)               ; Insertion point
        (cons 40 0.5)               ; Text height (adjust as needed)
        (cons 41 0.0)               ; Reference rectangle width
        (cons 71 x)                 ; 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
)

 

 

Edited September 9 by mhupp

[BlackBox]

3 hours ago, mhupp said:

This would create a text with top left just if the rotation angle is between 0 and 180 else it will be Bottom left.

 

(defun create-level-mtext (pt1 rot / mtext-obj)
  (if (and rot (> rot 0) (< rot pi) ;check rotation angle
    (setq x 1)
    (Setq x 7)
  )
  (setq mtext-obj
    (entmakex 
      (list
        (cons 0 "MTEXT")
        (cons 100 "AcDbEntity")
        (cons 8 (getvar "CLAYER"))  ; Current layer
        (cons 100 "AcDbMText")
        (cons 10 pt1)               ; Insertion point
        (cons 40 0.5)               ; Text height (adjust as needed)
        (cons 41 0.0)               ; Reference rectangle width
        (cons 71 x)                 ; 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
)

 

 

After you account for '; error: too few arguments:'... Might also consider a single < comparer for limiting this to positive X quadrants, a neither 0 or pi check for all quadrants, etc: 

(if (and rot (< 0 rot pi))                                              ;check rotation angle
  (setq x 1)
  (setq x 7)
)

(if (and rot (/= 0 rot) (/= pi rot))                                    ;check rotation angle
  (setq x 1)
  (setq x 7)
)

(setq x
       (if (and rot (/= 0 rot) (/= pi rot))                             ;check rotation angle
         1
         7
       )
)

 

[mhupp]

Don't have cad anymore to test this things  and cant remember if you could throw an if statement inside the entmakex function.

[BlackBox]

2 minutes ago, mhupp said:

Don't have cad anymore to test this things  and cant remember if you could throw an if statement inside the entmakex function.

Sorry to hear that; I didn't know. 

 

Agree it's better to test if you have the data needed before entmake* functions. 

 

If you're wanting to get CAD back, consider joining AUGI as Pro members get a free ADN (Autodesk Developer Network) membership, which would give you any Autodesk product to use for development. 

 

https://www.augi.com/adn-membership-offer

 

Cheers

[GLAVCVS]

Hi
I'm having trouble reconciling my understanding of your question with what I see in the example drawing.
The square: doesn't it also play a role in determining the text justification?
That is to say: if you select the upper right corner of the square and then specify a horizontal angle to the left, the justification should be bottom right.
However, if you do the same thing starting from the lower right corner of the square, the MTEXT justification should be top right.
Therefore, the idea seems to be that the MTEXT should always be positioned outside the square.

Is this correct?

In this case, the MTEXT angle criterion alone is not sufficient; it's also necessary to consider the object to which it refers.

If all of this is correct, we would need to write a function that analyzes the geometry of the object the MTEXT refers to and determines the justification, taking the angle into account as well.

[CivilTechSource]

@GLAVCVS You are absolutely correct. Ideally the user will select the polyline which represents a house and we calculate to place the text outside. However, we do not always get the building outline from the architects as a single polyline and I do not wish to spent time creating that polyline (for now). So I am focusing on at least having the correct Left/Right justification.... Unless I use something similar to LeeMacs  Text Alignment Controls https://www.lee-mac.com/curvealignedtext.html . But at the moment this is slightly over my head for now.

 

However, we could solve this issue without taking in consideration of geometry and take a similar approach to how you set the UCS, by selecting 3 points.

p1-TextPlacement

p2-Text Left & Right Justification based on p1

p3-Text Top & Right Justification based on p1 & p2

Would that work?

[GLAVCVS]

Even if you create MTEXT objects without referencing any other object, they will still have some kind of arbitrary geometry.

You could establish a rule that the perimeter points are always entered in a clockwise order

This would allow the code to have the necessary criteria to determine what is inside and outside the perimeter.

Additionally, the code could dynamically draw a perimeter based on each insertion point specified by the user.

As a convention for these temporary perimeters, you could assign them a specific, distinct color.

All of this could later allow you to write code for another command that manages these perimeters and their associated MTEXT objects, and then replaces them with the final, definitive version.

Edited September 10 by GLAVCVS

[BIGAL]

@CivilTechSource "spent time creating that polyline" one way out of making a pline around multi objects provided there are no gaps is to use BPOLY, draw a random pline around the objects, use BPOLY and pick a point between the dummy pline and the objects you should get two new plines, erase  the dummy and new outer pline, but you have now a new boundary pline. Use say layiso first to limit objects and  set a dummy layer.

 

Need a real dwg to see what is going on.

Edited September 11 by BIGAL

[CivilTechSource]

@BIGAL apologies if my query was not clear. I am trying basically to create the mtext around a house and I want the text justification to be relative to the points the user clicks.

I think I will be approaching it using the three point system.

e.g. if P1 & P2 angle is between between 270 to 90 then justification will be left and then check where p3 X,Y is relative to p1 X,Y to establish if top or bottom. Therefore it will be Top Left.

[BIGAL]

No worries, you made a comment about the difficulty of making the desired pline, that is what I was what I was suggesting.

[CivilTechSource]

I finally figured it out using angles and 3 point system similar to UCS. I took it a step further and added option for prefix and suffix as at my work we add the plus icon as a spot level marker.

Let me know what you think. Any suggestions to improved the code make it more lean are welcomed.

(defun c:LE-CalExtFFL ( / pt1 pt2 pt3 TxtRotation TxtJustification radians degrees pi)
  (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"))
    (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))
      (setq ffl-value (ExtractFFLValue ffl-text))
      (if ffl-value
        (progn
          (setq SpotLevel (- 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): ")
        )
      )
    )
  )

  (setq pi 3.141592653589793)
  (setq TxtJustification 1)
  (setq TxtRotation 0)
  (setq pt1 (getpoint "\nSelect first point: "))
  (setq pt2 (getpoint "\nSelect second point: "))
  (setq pt3 (getpoint "\nSelect third point for rotation reference: "))
  (setq TxtRotation (angle pt1 pt2))
  (setq TxtValue SpotLevel)
  (DefMTextJustification pt1 pt2 pt3 )
  (CreateMText pt1 TxtValue TxtRotation TxtJustification)
)


(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) 1.570796327))
          (>= (angle p1 p2) 4.71238898))
    (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
)

 

[BIGAL]

"PI" is a valid lisp reserved variable  so no need to work out all the angle values as decimal values.

 

0=0

90= (/ pi 2.) = 1.5707963267949

180= pi

270 = (* 1.5 pi)

45 = (* pi 0.25)

and so on, in code where lots of hor and ver angles are used can just pre-set angles eg (setq a90 (/ pi 2.))

[GLAVCVS]

On 9/12/2025 at 6:53 PM, CivilTechSource said:

I finally figured it out using angles and 3 point system similar to UCS. I took it a step further and added option for prefix and suffix as at my work we add the plus icon as a spot level marker.

Let me know what you think. Any suggestions to improved the code make it more lean are welcomed.

(defun c:LE-CalExtFFL ( / pt1 pt2 pt3 TxtRotation TxtJustification radians degrees pi)
  (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"))
    (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))
      (setq ffl-value (ExtractFFLValue ffl-text))
      (if ffl-value
        (progn
          (setq SpotLevel (- 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): ")
        )
      )
    )
  )

  (setq pi 3.141592653589793)
  (setq TxtJustification 1)
  (setq TxtRotation 0)
  (setq pt1 (getpoint "\nSelect first point: "))
  (setq pt2 (getpoint "\nSelect second point: "))
  (setq pt3 (getpoint "\nSelect third point for rotation reference: "))
  (setq TxtRotation (angle pt1 pt2))
  (setq TxtValue SpotLevel)
  (DefMTextJustification pt1 pt2 pt3 )
  (CreateMText pt1 TxtValue TxtRotation TxtJustification)
)


(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) 1.570796327))
          (>= (angle p1 p2) 4.71238898))
    (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
)

 

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
)

 

Edited yesterday at 07:32 AM by GLAVCVS

[CivilTechSource]

@GLAVCVS The visualisation is so awesome! I managed (with some Claude help) to make it work with your suggestion and have it looped! I think the software no is perfect? OR there is still room for improvement??/

;; LE-CalExtFFL - Calculate External Finished Floor Level
;; Improved version with better error handling and structure

(defun c:LE-CalcExtFFL ( / ffl-ent ffl-obj ffl-text ffl-value spot-level 
                         pt1 pt2 pt3 txt-rotation txt-justification 
                         prefix suffix pi continue-loop placement-count)
  
  ;; Constants
  (setq pi 3.141592653589793)
  
  ;; Initialize variables
  (setq prefix ""
        suffix ""
        txt-justification 1
        txt-rotation 0.0
        continue-loop T
        placement-count 0)
  
  ;; Set layer
  (if (not (SetWorkingLayer "-LE-E-External Levels"))
    (progn
      (princ "\nError: Could not create or set layer.")
      (exit)
    )
  )
  
  ;; Get FFL reference text (only once)
  (setq ffl-value (GetFFLReference))
  (if (not ffl-value)
    (progn
      (princ "\nOperation cancelled or invalid FFL selected.")
      (exit)
    )
  )
  
  ;; Calculate spot level (FFL - 0.15)
  (setq spot-level (- ffl-value 0.15))
  (princ (strcat "\nFFL Value: " (rtos ffl-value 2 3)))
  (princ (strcat "\nCalculated spot level: " (rtos spot-level 2 3)))
  
  ;; Main placement loop - continues until user exits
  (princ "\n" )
  (princ "\n========================================")
  (princ "\nPlace level markers using 3-point method")
  (princ "\nPress ESC or Enter at any prompt to finish")
  (princ "\n========================================")
  
  (while continue-loop
    (princ (strcat "\n\nMarker #" (itoa (1+ placement-count)) ":"))
    (setq pt1 (getpoint "\nSelect first point (text location): "))
    
    (if pt1
      (progn
        (setq pt2 (getpoint pt1 "\nSelect second point (direction): "))
        
        (if pt2
          (progn
            (virtualiza) ; Function to select third point and visualize
          )
          (progn
            (princ "\nPlacement cancelled.")
            (setq continue-loop nil) ; User cancelled pt2
          )
        )
      )
      (progn
        (setq continue-loop nil) ; User cancelled pt1 or pressed Enter
      )
    )
  )
  
  (princ (strcat "\nCommand completed. " (itoa placement-count) " level markers created."))
  (princ)
)

;; Function to set working layer
(defun SetWorkingLayer (layer-name / )
  (if (tblsearch "LAYER" layer-name)
    (progn
      (command "._layer" "_s" layer-name "")
      T
    )
    (progn
      (command "._layer" "_m" layer-name "")
      (if (tblsearch "LAYER" layer-name)
        (progn
          (command "._layer" "_s" layer-name "")
          T
        )
        nil
      )
    )
  )
)

;; Function to get FFL reference value
(defun GetFFLReference ( / ffl-ent ffl-obj ffl-text)
  (princ "\nSelect FFL reference text: ")
  (setq ffl-ent (car (entsel)))
  
  (cond
    ((not ffl-ent)
     (princ "\nNo entity selected.")
     nil
    )
    
    ((not (= (cdr (assoc 0 (entget ffl-ent))) "MTEXT"))
     (princ "\nSelected entity is not MTEXT. Please select MTEXT containing FFL value.")
     nil
    )
    
    (T
     (setq ffl-obj (entget ffl-ent)
           ffl-text (cdr (assoc 1 ffl-obj)))
     
     (princ (strcat "\nFFL Text found: " ffl-text))
     (ExtractFFLValue ffl-text)
    )
  )
)

;; Improved FFL value extraction
(defun ExtractFFLValue (text-string / clean-text numeric-value)
  (if (not text-string)
    (progn
      (princ "\nError: Empty text string.")
      nil
    )
    (progn
      ;; Remove first 5 characters if string is long enough
      (if (> (strlen text-string) 5)
        (setq clean-text (substr text-string 6))
        (setq clean-text text-string)
      )
      
      ;; Try to extract numeric value
      (setq numeric-value (ExtractNumericFromString clean-text))
      
      (if numeric-value
        (progn
          (princ (strcat "\nExtracted FFL value: " (rtos numeric-value 2 3)))
          numeric-value
        )
        (progn
          (princ "\nError: Could not extract numeric value from FFL text.")
          (princ (strcat "\nProcessed text: '" clean-text "'"))
          nil
        )
      )
    )
  )
)

;; Extract numeric value from string (handles various formats)
(defun ExtractNumericFromString (str / i char result decimal-found)
  (setq result ""
        decimal-found nil
        i 1)
  
  (while (<= i (strlen str))
    (setq char (substr str i 1))
    (cond
      ;; Numeric characters
      ((and (>= (ascii char) 48) (<= (ascii char) 57))
       (setq result (strcat result char))
      )
      ;; Decimal point (only first one)
      ((and (= char ".") (not decimal-found))
       (setq result (strcat result char)
             decimal-found T)
      )
      ;; Negative sign (only at start)
      ((and (= char "-") (= i 1))
       (setq result (strcat result char))
      )
    )
    (setq i (1+ i))
  )
  
  (if (and (> (strlen result) 0) (numberp (read result)))
    (read result)
    nil
  )
)

;; Set text justification and prefix/suffix based on geometry
(defun SetTextJustificationAndFixes (p1 p2 p3 / angle12 angle13 pi)
  (setq pi 3.141592653589793
        angle12 (angle p1 p2)
        angle13 (angle p1 p3))
  
  ;; Normalize angles to 0-2π range
  (if (< angle12 0) (setq angle12 (+ angle12 (* 2 pi))))
  (if (< angle13 0) (setq angle13 (+ angle13 (* 2 pi))))
  
  (cond
    ;; Text direction is roughly horizontal (right-going) or vertical up
    ((or (and (>= angle12 0.0) (<= angle12 1.570796327))      ; 0° to 90°
         (>= angle12 4.712388980))                             ; 270° to 360°
     
     (setq txt-justification 1    ; Top Left
           prefix "+"
           suffix "")
     
     ;; Check if reference point suggests bottom alignment
     (if (> angle13 angle12)
       (progn
         (setq txt-justification 7  ; Bottom Left
               prefix "+"
               suffix "")
         ;; Special case for horizontal line with reference below
         (if (and (< (abs angle12) 0.1) (> angle13 4.71238898))
           (setq txt-justification 1  ; Back to Top Left
                 prefix "+"
                 suffix "")
         )
       )
     )
    )
    
    ;; Text direction is roughly horizontal (left-going)
    (T
     (setq txt-justification 3    ; Top Right
           prefix ""
           suffix "+"
           txt-rotation (+ txt-rotation pi))  ; Flip text 180°
     
     ;; Adjust justification based on reference point
     (if (> angle13 angle12)
       (setq txt-justification 3    ; Top Right
             prefix ""
             suffix "+")
       (setq txt-justification 9    ; Bottom Right
             prefix ""
             suffix "+")
     )
    )
  )
)

;; Create MText entity with specified parameters
(defun CreateLevelMText (point txt-value txt-rotation txt-justification prefix suffix / mtext-obj)
  (setq mtext-obj 
    (entmakex 
      (list
        (cons 0 "MTEXT")
        (cons 100 "AcDbEntity")
        (cons 8 (getvar "CLAYER"))        ; Current layer
        (cons 62 256)                     ; Color by layer
        (cons 100 "AcDbMText")
        (cons 10 point)                   ; Insertion point
        (cons 40 0.5)                     ; Text height
        (cons 41 0.0)                     ; Reference rectangle width
        (cons 71 txt-justification)       ; Attachment point
        (cons 72 5)                       ; Drawing direction
        (cons 1 (strcat prefix (rtos txt-value 2 2) suffix))  ; Text content
        (cons 50 txt-rotation)            ; Rotation angle
        (cons 73 1)                       ; Line spacing style
        (cons 44 1.0)                     ; Line spacing factor
      )
    )
  )
  
  (if mtext-obj
    T
    nil
  )
)

;; Utility function to convert radians to degrees (for debugging)
(defun RadiansToDegrees (radians)
  (* radians (/ 180.0 3.141592653589793))
)

(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)))
)


;; Print startup message
(princ "\nLE-CalExtFFL command loaded. Type LE-CalExtFFL to run.")
(princ)

 

Edited 21 hours ago by CivilTechSource

[BIGAL]

Maybe you miss understood my comment, PI is an inbuilt function (princ pi) type it, so you can have the other angles as just ( / pi 2.) and so on. You don't need to declare it.

[GLAVCVS]

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
)

 

Edited 3 hours ago by GLAVCVS

[Tsuky]

For a start, my 2 cents...

(defun q_ang (alpha / )
  (cond
    ((not (eq (rem alpha (/ (* 3 pi) 2)) alpha)) 4)
    ((not (eq (rem alpha pi) alpha)) 3)
    ((not (eq (rem alpha (/ pi 2)) alpha)) 2)
    (T 1)
  )
)
(defun c:wow ( / ss ent dxf_ent ptlst n pt_cen dir_ang tmp n rot)
  (princ "\nSelect closed polylines")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&") (70 . 1))))
  (cond
    (ss
      (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)
      )
      (mapcar
        '(lambda (p d / j)
          (setq qsel (ssget "_C" (mapcar '- p (list tmp tmp 0.0)) (mapcar '+ p (list tmp tmp 0.0)) '((0 . "MTEXT"))))
          (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) (setq j 7)))
            (if (eq d 2) (if (zerop rot) (setq j 7) (setq j 1)))
            (if (eq d 3) (if (zerop rot) (setq j 1) (setq j 7)))
            (if (eq d 4) (if (zerop rot) (setq j 3) (setq j 1)))
            (setq dxf_ent (subst (cons 10 p) (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)
)