;;; ---------------------------------------------------------------------------
;;; TextFrame.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Draws a rectangular polyline box around selected Text and MText, at an
;;; offset proportional to the text height. Optionally with rounded corners.
;;;
;;; Equivalent to the Express Tools TCIRCLE command, but with a fillet option
;;; and without needing Express Tools installed.
;;;
;;; THE OFFSET IS A FACTOR, NOT A DISTANCE
;;; You give a multiplier of the text height rather than an absolute value, so
;;; one setting produces visually consistent boxes across a selection
;;; containing several different text sizes. A factor of 0.35 - the default -
;;; puts the frame just over a third of a character height clear of the text.
;;;
;;; The factor and the fillet preference are remembered between sessions, held
;;; in AutoCAD's environment settings rather than in memory, so they survive
;;; closing and reopening the program.
;;;
;;; Each frame inherits the layer, linetype, lineweight, colour and thickness
;;; of the text it surrounds, so boxes land on the same layer as their text
;;; without any further tidying.
;;;
;;; Works with text at any rotation and in any UCS.
;;;
;;;   TEXTFRAME  - box selected text
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; Environment keys used to remember settings between sessions.
(setq TextFrame:OffsetKey "YZ\\textframe-offset"
      TextFrame:FilletKey "YZ\\textframe-fillet"
)

;; ---------------------------------------------------------------------------
;; TextFrame:Doc  -  cached active document
;; ---------------------------------------------------------------------------
(defun TextFrame:Doc nil
    (eval (list 'defun 'TextFrame:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (TextFrame:Doc)
)

;; ---------------------------------------------------------------------------
;; TextFrame:MxV  -  matrix multiplied by vector
;; ---------------------------------------------------------------------------
;; Namespaced deliberately; the original defined a bare global "mxv", generic
;; enough that another routine could silently replace it.
;; ---------------------------------------------------------------------------
(defun TextFrame:MxV ( m v )
    (mapcar (function (lambda ( row ) (apply '+ (mapcar '* row v)))) m)
)

;; ---------------------------------------------------------------------------
;; TextFrame:DefaultProps
;; ---------------------------------------------------------------------------
;; Returns a full set of common property groups for the supplied entity data,
;; substituting AutoCAD's defaults wherever the entity omits one.
;;
;; The substitution matters: an object on layer 0 with BYLAYER colour simply
;; carries no group 8 or 62 - the absence IS the default - so without filling
;; them in, the frame would not inherit them.
;; ---------------------------------------------------------------------------
(defun TextFrame:DefaultProps ( enx )
    (mapcar (function (lambda ( pair ) (cond ((assoc (car pair) enx)) ( pair ))))
       '(
            (006 . "BYLAYER")   ; linetype
            (008 . "0")         ; layer
            (039 . 0.0)         ; thickness
            (048 . 1.0)         ; linetype scale
            (062 . 256)         ; colour, 256 = BYLAYER
            (370 . -1)          ; lineweight, -1 = BYLAYER
        )
    )
)

;; ---------------------------------------------------------------------------
;; TextFrame:Box
;; ---------------------------------------------------------------------------
;; Returns the four corner points of the frame, in the entity's own coordinate
;; system, offset outward by off.
;;
;; TEXT and MTEXT need entirely different treatment:
;;
;;   TEXT  - the textbox function returns the extents directly, relative to the
;;           insertion point. The four corners are then simply those extents
;;           pushed out by the offset.
;;
;;   MTEXT - has no textbox equivalent, so the box is derived from its stored
;;           width (DXF 42) and height (DXF 43). The origin has to be computed
;;           from the attachment point (DXF 71), because an MText attached at
;;           its middle-centre sits half its width left and half its height
;;           below its insertion point, whereas one attached top-left sits
;;           exactly on it. The two cond expressions decode that 1-9 grid:
;;           columns 2/5/8 are centred, 3/6/9 are right; rows 1/2/3 are top,
;;           4/5/6 are middle.
;;
;; Whichever path produced the corners, they are finally rotated by the text
;; rotation and translated onto the base point.
;; ---------------------------------------------------------------------------
(defun TextFrame:Box ( enx off / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (= "TEXT" (cdr (assoc 0 enx)))
            (setq bpt (cdr (assoc 10 enx))
                  rot (cdr (assoc 50 enx))
                  lst (textbox enx)
                  lst (list
                          (list (- (caar  lst) off) (- (cadar  lst) off))
                          (list (+ (caadr lst) off) (- (cadar  lst) off))
                          (list (+ (caadr lst) off) (+ (cadadr lst) off))
                          (list (- (caar  lst) off) (+ (cadadr lst) off))
                      )
            )
        )
        (   (= "MTEXT" (cdr (assoc 0 enx)))
            (setq ocs (cdr (assoc 210 enx))
                  bpt (trans (cdr (assoc 10 enx)) 0 ocs)
                  ;; DXF 11 is the MText direction vector; its angle is the
                  ;; rotation, which is more reliable than DXF 50 for MText.
                  rot (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                  wid (cdr (assoc 42 enx))
                  hgt (cdr (assoc 43 enx))
                  jus (cdr (assoc 71 enx))
                  org (list
                          (cond ((member jus '(2 5 8)) (/ wid -2.0))
                                ((member jus '(3 6 9)) (- wid))
                                (0.0)
                          )
                          (cond ((member jus '(1 2 3)) (- hgt))
                                ((member jus '(4 5 6)) (/ hgt -2.0))
                                (0.0)
                          )
                      )
                  lst (list
                          (list (- (car org) off)     (- (cadr org) off))
                          (list (+ (car org) wid off) (- (cadr org) off))
                          (list (+ (car org) wid off) (+ (cadr org) hgt off))
                          (list (- (car org) off)     (+ (cadr org) hgt off))
                      )
            )
        )
    )

    (if lst
        (   (lambda ( m )
                (mapcar (function (lambda ( p ) (mapcar '+ (TextFrame:MxV m p) bpt))) lst)
            )
            (list (list (cos rot) (sin (- rot)) 0.0)
                  (list (sin rot) (cos rot)     0.0)
                 '(0.0 0.0 1.0)
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; TextFrame:Fillet
;; ---------------------------------------------------------------------------
;; Converts the four corner points into the eight-vertex arc-and-line sequence
;; that produces a rounded rectangle.
;;
;; Each corner becomes two vertices: one where the straight edge stops and the
;; arc begins, one where the arc ends and the next edge starts. The first of
;; each pair carries a BULGE, the second carries none.
;;
;; The bulge value of sqrt(2) - 1 is exact for a quarter circle. Bulge is the
;; tangent of one quarter of the included angle, and for a 90 degree arc that
;; is tan(22.5 degrees), which equals sqrt(2) - 1.
;;
;; The offsets are rotated by the box's own rotation before being applied, so
;; the fillets sit correctly on rotated text.
;; ---------------------------------------------------------------------------
(defun TextFrame:Fillet ( lst rad / blg mat rot )
    (setq blg (1- (sqrt 2.0))
          rot (angle (car lst) (cadr lst))
          mat (list (list (cos rot) (sin (- rot)))
                    (list (sin rot) (cos rot))
              )
    )
    (apply 'append
        (mapcar
            (function
                (lambda ( pt offsets )
                    (apply 'append
                        (mapcar
                            (function
                                (lambda ( v b )
                                    (list (cons 10 (mapcar '+ pt (TextFrame:MxV mat v)))
                                          (cons 42 b)
                                    )
                                )
                            )
                            offsets (list blg 0.0)
                        )
                    )
                )
            )
            lst
            ;; Per corner: where the arc starts, and where it ends.
            (list
                (list (list 0.0     rad) (list rad     0.0))
                (list (list (- rad) 0.0) (list 0.0     rad))
                (list (list 0.0 (- rad)) (list (- rad) 0.0))
                (list (list rad     0.0) (list 0.0 (- rad)))
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; TextFrame:Ssget
;; ---------------------------------------------------------------------------
;; ssget with a custom prompt. NOMUTT suppresses the built-in "Select objects:"
;; chatter so the supplied message is the only thing the user sees, and is
;; restored to its captured value rather than assumed to have been zero.
;; ---------------------------------------------------------------------------
(defun TextFrame:Ssget ( msg arg / mutt sel )
    (princ msg)
    (setq mutt (getvar 'nomutt))
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt mutt)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; ---------------------------------------------------------------------------
;; c:TEXTFRAME  -  main routine
;; ---------------------------------------------------------------------------
;; Note that the original left two variables undeclared, leaking them globally
;; on every run. All are localised here.
;; ---------------------------------------------------------------------------
(defun c:TEXTFRAME ( / *error* vars vals def off fil answer sel idx enx rad lst count )

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    (defun TextFrame:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

    (defun *error* ( msg )
        (TextFrame:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TEXTFRAME error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    ;; Recover the remembered offset factor, seeding it on first ever use.
    (if (or (not (setq def (getenv TextFrame:OffsetKey)))
            (not (setq def (distof def 2)))
        )
        (setenv TextFrame:OffsetKey (rtos (setq def 0.35) 2 2))
    )

    ;; initget 4 rejects negative input; zero is allowed and gives a frame
    ;; tight against the text extents.
    (initget 4)
    (if (setq off (getreal (strcat "\nSpecify offset factor <" (rtos def 2 2) ">: ")))
        (setenv TextFrame:OffsetKey (rtos off 2 2))
        (setq off def)
    )

    ;; A fillet is only meaningful when there is an offset to round off, so the
    ;; question is only asked when the offset is greater than zero.
    (if (< 0.0 off)
        (progn
            (setq fil (= "Yes" (getenv TextFrame:FilletKey)))
            (initget "Yes No")
            (if (setq answer (getkword (strcat "\nFillet the corners? [Yes/No] <"
                                               (if fil "Yes" "No") ">: ")))
                (setq fil (= "Yes" (setenv TextFrame:FilletKey answer)))
            )
        )
    )

    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
    ;; unless the routine says up front that it will use one. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (if (setq sel (TextFrame:Ssget "\nSelect text or mtext to frame: "
                                  '(((0 . "TEXT,MTEXT")))
                  )
        )
        (progn
            (setq count 0)
            (repeat (setq idx (sslength sel))
                (setq enx (entget (ssname sel (setq idx (1- idx))))
                      ;; The offset in drawing units for THIS object - the
                      ;; factor multiplied by its own text height.
                      rad (* off (cdr (assoc 40 enx)))
                      lst (TextFrame:Box enx rad)
                )
                (if lst
                    (progn
                        (entmake
                            (append
                                (list '(000 . "LWPOLYLINE")
                                      '(100 . "AcDbEntity")
                                      '(100 . "AcDbPolyline")
                                      ;; Eight vertices when filleted, four when not.
                                      (if fil '(090 . 8) '(090 . 4))
                                      '(070 . 1)       ; closed
                                )
                                (TextFrame:DefaultProps enx)
                                ;; Elevation, taken from the box itself so the
                                ;; frame sits in the same plane as the text.
                                (list (cons 038 (caddar lst)))
                                (if fil
                                    (TextFrame:Fillet lst rad)
                                    (mapcar (function (lambda ( p ) (cons 10 p))) lst)
                                )
                                (list (assoc 210 enx))
                            )
                        )
                        (setq count (1+ count))
                    )
                )
            )
            (princ (strcat "\n" (itoa count)
                           " text object" (if (= 1 count) "" "s") " framed."
                   )
            )
        )
        (princ "\nNothing selected.")
    )

    (TextFrame:Restore)
    (princ)
)

(princ)