;;; ---------------------------------------------------------------------------
;;; TextShell.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; A BOX AROUND TEXT THAT KEEPS UP WITH IT
;;;
;;; Draw a rectangle, circle, slot or rounded rectangle around a piece of
;;; text, and it stays around that text. Edit the wording and the shell
;;; resizes. Change the height, style or justification and it resizes. Move,
;;; rotate or copy the text and the shell follows.
;;;
;;; This is the difference between a shell and a box you drew yourself. A
;;; drawn box is right once. A shell is right permanently, which matters on
;;; revision clouds, room tags, detail markers and any label that gets edited
;;; twice a week for six months.
;;;
;;; Four shapes are available:
;;;
;;;   RECTANGLE  a plain box, offset evenly around the text
;;;   FILLETED   a box with rounded corners
;;;   SLOT       a box with fully rounded left and right ends
;;;   CIRCLE     a circle through the box corners, for balloon-style tags
;;;
;;; The offset factor controls the gap. It is a MULTIPLE of the text height,
;;; not a fixed distance, so a shell drawn around 2.5mm text and one drawn
;;; around 100mm text look the same. Change the text height and the gap
;;; scales with it.
;;;
;;; ---------------------------------------------------------------------------
;;; HOW IT WORKS
;;;
;;; Two pieces of machinery hold the pairing together.
;;;
;;; 1. EXTENDED ENTITY DATA
;;;    Both the text and its shell carry a small block of xdata under a
;;;    private application name. Each one records the HANDLE of its partner,
;;;    plus the shape and offset factor in use.
;;;
;;;    Handles are used rather than entity names because a handle is
;;;    permanent: it survives saving, closing and reopening the drawing,
;;;    where an entity name does not. That is what allows shells to keep
;;;    working after the file has been round-tripped.
;;;
;;; 2. OBJECT REACTORS
;;;    Two reactors watch for changes. One is attached to every shelled text
;;;    object, the other to every shell. When either is modified, the
;;;    callback reads the xdata, finds the partner by handle, and rebuilds
;;;    the shell around the text's current extents.
;;;
;;; ---------------------------------------------------------------------------
;;; WHY THE COMMAND REACTOR DANCE
;;;
;;; A modification reactor is forbidden from modifying the drawing while it
;;; is running -- AutoCAD is mid-edit and the database is not safe to touch.
;;; So when a shell is dragged, the callback cannot immediately rebuild it.
;;;
;;; Instead it remembers which object needs attention and creates a temporary
;;; COMMAND reactor. That fires the moment the command finishes, when the
;;; database is stable again, and the rebuild happens then. The temporary
;;; reactor removes itself straight away, so they never accumulate.
;;;
;;; The same trick handles copying. When a shelled text is copied, the new
;;; copy inherits the xdata -- pointing at the ORIGINAL shell, which would be
;;; wrong. The copy callback queues the new object and, once the command
;;; ends, builds it a shell of its own and repoints the xdata. Copying a
;;; SHELL on its own instead deletes the copy, since a shell with no text is
;;; meaningless.
;;;
;;; ---------------------------------------------------------------------------
;;; WHY THE STATE IS GLOBAL
;;;
;;; Reactor callbacks run long after the command that created them has
;;; returned, so there is no enclosing function whose locals they could see.
;;; The reactor handles, the pending-object queue and the shape settings must
;;; therefore live at global scope. Every one is namespaced with a
;;; "*TextShell:...*" prefix.
;;;
;;; ---------------------------------------------------------------------------
;;; CAVEATS
;;;
;;; Reactors do not survive between drawings. This file re-establishes them
;;; from the xdata every time it is loaded, so load it from acaddoc.lsp if
;;; you want shells live in every drawing you open. Until it is loaded the
;;; shells are simply ordinary geometry -- nothing is lost, they just stop
;;; updating.
;;;
;;; UNSHELL breaks the link and leaves both objects in place as normal
;;; geometry.
;;;
;;; ---------------------------------------------------------------------------
;;;   TEXTSHELL - draw a shell around text and link the two
;;;   UNSHELL   - break the link, leaving both objects behind
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; Registered application name used to tag both halves of a pair. Any
;;; entity carrying xdata under this name is part of a shell pairing.
;;; ---------------------------------------------------------------------------

(setq *TextShell:App* "YZ_TEXTSHELL")

;;; ---------------------------------------------------------------------------
;;; Runtime state. Global for the reasons set out in the header.
;;;
;;;   *TextShell:TextReactor*  reactor watching the text objects
;;;   *TextShell:ShellReactor* reactor watching the shells
;;;   *TextShell:Pending*      objects queued for rebuilding once the current
;;;                            command finishes
;;;   *TextShell:Offset*       last offset factor used, as a multiple of the
;;;                            text height
;;;   *TextShell:Shape*        last shape chosen
;;; ---------------------------------------------------------------------------

(setq *TextShell:Pending* nil)
(or *TextShell:Offset* (setq *TextShell:Offset* 0.35))
(or *TextShell:Shape*  (setq *TextShell:Shape* "Rectangle"))

;;; ---------------------------------------------------------------------------
;;; TextShell:Doc
;;;
;;; Returns the active document, caching itself after the first call.
;;; ---------------------------------------------------------------------------

(defun TextShell:Doc nil
    (eval (list 'defun 'TextShell:Doc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (TextShell:Doc)
)

;;; ===========================================================================
;;; TEXTSHELL  -  draw a shell around text
;;; ===========================================================================

(defun c:TextShell ( / *error* ent enx shell vals vars )

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

    (defun *error* ( msg )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TEXTSHELL error: " msg " **"))
        )
        (princ)
    )

    (setvar 'cmdecho 0)

    ;; ---- settings ----------------------------------------------------------
    ;; Both prompts default to whatever was used last, so shelling a run of
    ;; labels is a matter of pressing Enter twice and then picking.

    (setq *TextShell:Offset*
        (cond
            (   (getdist (strcat "\nSpecify offset factor <"
                                 (rtos *TextShell:Offset* 2 2) ">: ")))
            (   *TextShell:Offset*)
        )
    )
    (initget "Circle Slot Rectangle Filleted")
    (setq *TextShell:Shape*
        (cond
            (   (getkword
                    (strcat "\nEnclose text with [Circle/Slot/Rectangle/Filleted rectangle] <"
                            *TextShell:Shape* ">: ")))
            (   *TextShell:Shape*)
        )
    )

    ;; ---- pick the text -----------------------------------------------------
    ;; The loop repeats until something valid is picked or the user presses
    ;; Enter. Every rejection explains itself, so the user is never left
    ;; guessing why a pick did not take.

    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect text or mtext: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= 'ename (type ent))
                    ;; Reading with the app name filter returns only OUR
                    ;; xdata, so the -3 test below cannot be confused by
                    ;; another application's data on the same object.
                    (setq enx (entget ent (list *TextShell:App*)))
                    (cond
                        (   (not (member (cdr (assoc 0 enx)) '("TEXT" "MTEXT")))
                            (princ "\nThat is not text or mtext.")
                        )
                        (   (assoc -3 enx)
                            (princ "\nThat text already has a shell.")
                        )
                        ;;  Bit 4 of DXF 70 on the layer record means locked.
                        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 enx)))))))
                            (princ "\nThat text is on a locked layer.")
                        )
                    )
                )
            )
        )
    )

    (if ent
        (progn
            ;; 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")
            ;; The application name must be registered before xdata can be
            ;; attached under it. Calling regapp again is harmless.
            (regapp *TextShell:App*)

            (if (setq shell (TextShell:Create enx (strcase *TextShell:Shape*) *TextShell:Offset*))
                (progn
                    ;; Tag the text with the shell's handle, the shape, and
                    ;; the offset factor, so the pairing can be rebuilt from
                    ;; the drawing alone after a reload.
                    ;;
                    ;; Group 40 is dropped from the list handed to entmod:
                    ;; leaving the height in place makes entmod re-apply it,
                    ;; which can subtly rescale MText. The shell only needs
                    ;; the xdata added, so the height is left untouched.
                    (entmod
                        (append (vl-remove (assoc 40 enx) enx)
                            (list
                                (list -3
                                    (list *TextShell:App*
                                       '(1002 . "{")                             ;; open xdata group
                                        (cons 1005 (cdr (assoc 5 (entget shell)))) ;; partner handle
                                        (cons 1000 (strcase *TextShell:Shape*))
                                        (cons 1040 *TextShell:Offset*)
                                       '(1002 . "}")                             ;; close xdata group
                                    )
                                )
                            )
                        )
                    )
                    (TextShell:Watch (vlax-ename->vla-object ent)  'text)
                    (TextShell:Watch (vlax-ename->vla-object shell) 'shell)
                    (princ "\nShell created and linked.")
                )
                (princ "\nUnable to create a shell for that object.")
            )
            (while (= 8 (logand 8 (getvar 'undoctl)))
                (command "_.UNDO" "_End")
                (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
            )
        )
    )

    (mapcar 'setvar vars vals)
    (princ)
)

;;; ===========================================================================
;;; UNSHELL  -  break the link between text and shell
;;; ===========================================================================
;;;
;;; Both objects stay in the drawing; they simply stop tracking one another.
;;; The xdata is stripped from both and both are detached from the reactors.
;;; ---------------------------------------------------------------------------

(defun c:UnShell ( / *error* all ent enx idx lck obj shell shellobj vals vars )

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

    (defun *error* ( msg )
        ;; Layers unlocked to do the work must be relocked whatever happens.
        (foreach lay lck (vl-catch-all-apply 'vla-put-lock (list lay :vlax-true)))
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** UNSHELL error: " msg " **"))
        )
        (princ)
    )

    (setvar 'cmdecho 0)

    ;; Every shelled object in the drawing, found by its xdata rather than by
    ;; layer or type. This is both the "All" target and the test for whether
    ;; there is anything to do at all.
    (setq all
        (ssget "_X" (list '(0 . "TEXT,MTEXT,CIRCLE,LWPOLYLINE")
                          (list -3 (list *TextShell:App*))))
    )

    (if (null all)
        (princ "\nNo shells found in this drawing.")
        (progn
            ;; 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")
            (while
                (progn
                    (setvar 'errno 0)
                    (initget "All Exit")
                    (setq ent (entsel "\nSelect text or shell to unlink [All/Exit] <Exit>: "))
                    (cond
                        (   (= 7 (getvar 'errno))
                            (princ "\nMissed, try again.")
                        )
                        (   (= "Exit" ent) nil)

                        ;;  ---- unlink everything ----
                        (   (= "All" ent)
                            ;; Locked layers are unlocked for the duration so
                            ;; that a shell on a locked layer is not silently
                            ;; skipped, then relocked exactly as they were.
                            (setq lck (TextShell:UnlockLayers))
                            (repeat (setq idx (sslength all))
                                (setq ent (ssname all (setq idx (1- idx))))
                                (TextShell:Unwatch (vlax-ename->vla-object ent))
                                (TextShell:StripData ent)
                            )
                            (foreach lay lck (vla-put-lock lay :vlax-true))
                            (setq lck nil)
                            (princ "\nAll shells unlinked.")
                            nil
                        )

                        ;;  ---- unlink one pair ----
                        (   (= 'ename (type (setq ent (car ent))))
                            (cond
                                (   (null (assoc -3 (setq enx (entget ent (list *TextShell:App*)))))
                                    (princ "\nThat object is not part of a shell.")
                                )
                                (   (null (vlax-write-enabled-p
                                              (setq obj (vlax-ename->vla-object ent))))
                                    (princ "\nThat object is on a locked layer.")
                                )
                                ;;  The partner is found through the handle
                                ;;  stored in the xdata.
                                (   (and
                                        (setq shell (handent (cdr (assoc 1005 (cdadr (assoc -3 enx))))))
                                        (setq shellobj (vlax-ename->vla-object shell))
                                        (null (vlax-write-enabled-p shellobj))
                                    )
                                    (princ
                                        (strcat "\nThe associated "
                                            (if (member (cdr (assoc 0 (entget shell))) '("TEXT" "MTEXT"))
                                                "text" "shell"
                                            )
                                            " is on a locked layer."
                                        )
                                    )
                                )
                                (   t
                                    (TextShell:Unwatch obj)
                                    (TextShell:StripData ent)
                                    (if shellobj (TextShell:Unwatch shellobj))
                                    ;; The partner may have been erased since
                                    ;; the pairing was made, so its existence
                                    ;; is confirmed before stripping it.
                                    (if (and shell (entget shell))
                                        (TextShell:StripData shell)
                                    )
                                    (princ "\nShell unlinked.")
                                    nil
                                )
                            )
                        )
                    )
                )
            )
            (while (= 8 (logand 8 (getvar 'undoctl)))
                (command "_.UNDO" "_End")
                (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
            )
        )
    )

    (mapcar 'setvar vars vals)
    (princ)
)

;;; ===========================================================================
;;;                       R E A C T O R   P L U M B I N G
;;; ===========================================================================

;;; ---------------------------------------------------------------------------
;;; TextShell:Watch
;;;
;;; Adds an object to the appropriate reactor, creating that reactor if it
;;; does not exist yet.
;;;
;;; Notification is set to 'active-document-only so the callbacks do not fire
;;; for drawings other than the one in front of the user, which would waste
;;; time and could act on a database that is not fully loaded.
;;;
;;;   obj  - VLA object to watch
;;;   kind - 'text or 'shell
;;; ---------------------------------------------------------------------------

(defun TextShell:Watch ( obj kind )
    (if (= 'text kind)
        (if (= 'vlr-object-reactor (type *TextShell:TextReactor*))
            (vlr-owner-add *TextShell:TextReactor* obj)
            (vlr-set-notification
                (setq *TextShell:TextReactor*
                    (vlr-object-reactor (list obj) "textshell-text"
                       '(
                            (:vlr-modified . TextShell:TextChanged)
                            (:vlr-copied   . TextShell:TextCopied)
                        )
                    )
                )
                'active-document-only
            )
        )
        (if (= 'vlr-object-reactor (type *TextShell:ShellReactor*))
            (vlr-owner-add *TextShell:ShellReactor* obj)
            (vlr-set-notification
                (setq *TextShell:ShellReactor*
                    (vlr-object-reactor (list obj) "textshell-shell"
                       '(
                            (:vlr-modified . TextShell:ShellChanged)
                            (:vlr-copied   . TextShell:ShellCopied)
                        )
                    )
                )
                'active-document-only
            )
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:Unwatch
;;;
;;; Detaches an object from whichever reactor is watching it. Which reactor
;;; that is follows from the object type: anything whose class name matches
;;; AcDb*Text is a text object, everything else is a shell.
;;; ---------------------------------------------------------------------------

(defun TextShell:Unwatch ( obj )
    (if (wcmatch (vla-get-objectname obj) "AcDb*Text")
        (if (= 'vlr-object-reactor (type *TextShell:TextReactor*))
            (vl-catch-all-apply 'vlr-owner-remove (list *TextShell:TextReactor* obj))
        )
        (if (= 'vlr-object-reactor (type *TextShell:ShellReactor*))
            (vl-catch-all-apply 'vlr-owner-remove (list *TextShell:ShellReactor* obj))
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:ReadData
;;;
;;; Reads this program's xdata from a VLA object and returns it as an
;;; ordinary association list of (groupcode . value) pairs.
;;;
;;; vla-GetXData hands back two parallel safearrays -- one of type codes, one
;;; of variant values -- which is unusable as it stands. Pairing them up and
;;; unwrapping the variants turns it into the same shape entget produces, so
;;; the rest of the code can use plain assoc.
;;;
;;; Returns nil if there is no xdata for this application.
;;; ---------------------------------------------------------------------------

(defun TextShell:ReadData ( obj / typ val )
    (if (and (vlax-read-enabled-p obj)
             (progn (vla-getxdata obj *TextShell:App* 'typ 'val) val)
        )
        (mapcar 'cons
            (vlax-safearray->list typ)
            (mapcar 'vlax-variant-value (vlax-safearray->list val))
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; TextShell:TextChanged        [ reactor callback ]
;;;
;;; The text was modified. Find its shell through the stored handle and
;;; rebuild it.
;;;
;;; MText is a special case. After MTEDIT the object's DXF data has not yet
;;; caught up, so measuring it here would produce a shell sized to the OLD
;;; text. For MText the work is therefore deferred through the command
;;; reactor route, exactly as a shell edit is, and by the time that fires the
;;; data is current.
;;; ---------------------------------------------------------------------------

(defun TextShell:TextChanged ( owner reactor params / ent enx val )
    (if
        (and
            (setq val (TextShell:ReadData owner))
            (setq ent (handent (cdr (assoc 1005 val))))
            (setq enx (entget ent))
            (vlax-write-enabled-p (vlax-ename->vla-object ent))
        )
        (if (= "AcDbMText" (vla-get-objectname owner))
            (TextShell:ShellChanged (vlax-ename->vla-object ent) nil nil)
            (TextShell:Rebuild
                (entget (vlax-vla-object->ename owner))
                (cdr (assoc 1000 val))
                (cdr (assoc 1040 val))
                enx
            )
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:ShellChanged       [ reactor callback ]
;;;
;;; The shell was modified -- typically dragged, or moved with its text.
;;;
;;; Nothing can be changed from inside a modification callback, so the object
;;; is queued and a temporary command reactor set up to do the work the
;;; instant the command ends.
;;; ---------------------------------------------------------------------------

(defun TextShell:ShellChanged ( owner reactor params )
    (setq *TextShell:Pending* (cons owner *TextShell:Pending*))
    (vlr-command-reactor "textshell-cmd"
       '(
            (:vlr-commandended     . TextShell:ShellCommandEnded)
            (:vlr-commandcancelled . TextShell:CommandCancelled)
            (:vlr-commandfailed    . TextShell:CommandCancelled)
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:ShellCommandEnded  [ reactor callback ]
;;;
;;; The command has finished and the database is safe to touch. Rebuild the
;;; queued shell around its text.
;;;
;;; The temporary command reactor removes itself first thing, so these never
;;; pile up no matter how many edits are made.
;;; ---------------------------------------------------------------------------

(defun TextShell:ShellCommandEnded ( reactor params / shell txt val )
    (vlr-remove reactor)
    (if
        (and
            (setq shell (car *TextShell:Pending*))
            (vlax-read-enabled-p  shell)
            (vlax-write-enabled-p shell)
            (setq val (TextShell:ReadData shell))
            (setq txt (entget (handent (cdr (assoc 1005 val)))))
        )
        (TextShell:Rebuild txt
            (cdr (assoc 1000 val))
            (cdr (assoc 1040 val))
            (entget (vlax-vla-object->ename shell))
        )
    )
    (setq *TextShell:Pending* (cdr *TextShell:Pending*))
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:CommandCancelled   [ reactor callback ]
;;;
;;; The command was cancelled or failed, so nothing should be rebuilt. The
;;; whole queue is discarded rather than just its head: a cancel can abandon
;;; several pending objects at once, and a stale entry would later be applied
;;; to the wrong edit.
;;; ---------------------------------------------------------------------------

(defun TextShell:CommandCancelled ( reactor params )
    (vlr-remove reactor)
    (setq *TextShell:Pending* nil)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:TextCopied         [ reactor callback ]
;;;
;;; A shelled text object was copied. The copy carries xdata pointing at the
;;; ORIGINAL shell, which would make two texts fight over one shell.
;;;
;;; The new object is queued so that a shell of its own can be built once the
;;; command ends. params holds the new entity; a car of 0 means no usable
;;; object was produced, which is ignored.
;;;
;;; The queue is appended to rather than pushed onto, so that copies made in
;;; one operation are processed in the order they were created.
;;; ---------------------------------------------------------------------------

(defun TextShell:TextCopied ( owner reactor params )
    (if (/= 0 (car params))
        (progn
            (setq *TextShell:Pending* (append *TextShell:Pending* (list (car params))))
            (vlr-command-reactor "textshell-copycmd"
               '(
                    (:vlr-commandended     . TextShell:TextCopyEnded)
                    (:vlr-commandcancelled . TextShell:CommandCancelled)
                    (:vlr-commandfailed    . TextShell:CommandCancelled)
                )
            )
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:TextCopyEnded      [ reactor callback ]
;;;
;;; Builds a fresh shell for a copied text object and repoints its xdata at
;;; the new shell, then attaches both to the reactors so the new pair is as
;;; live as the original.
;;; ---------------------------------------------------------------------------

(defun TextShell:TextCopyEnded ( reactor params / ent enx shell val )
    (vlr-remove reactor)
    (if
        (and
            (setq ent (car *TextShell:Pending*))
            (setq enx (entget ent (list *TextShell:App*)))
            (member (cdr (assoc 0 enx)) '("TEXT" "MTEXT"))
            (setq val (cdadr (assoc -3 enx)))
            (setq shell (TextShell:Create enx (cdr (assoc 1000 val)) (cdr (assoc 1040 val))))
        )
        (progn
            (entmod
                (append (vl-remove (assoc 40 enx) (entget ent))
                    (list
                        (list -3
                            (list *TextShell:App*
                               '(1002 . "{")
                                (cons  1005 (cdr (assoc 5 (entget shell))))
                                (assoc 1000 val)     ;; same shape as the original
                                (assoc 1040 val)     ;; same offset as the original
                               '(1002 . "}")
                            )
                        )
                    )
                )
            )
            (if (= 'vlr-object-reactor (type *TextShell:TextReactor*))
                (vlr-owner-add *TextShell:TextReactor* (vlax-ename->vla-object ent))
            )
            (if (= 'vlr-object-reactor (type *TextShell:ShellReactor*))
                (vlr-owner-add *TextShell:ShellReactor* (vlax-ename->vla-object shell))
            )
        )
    )
    (setq *TextShell:Pending* (cdr *TextShell:Pending*))
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:ShellCopied        [ reactor callback ]
;;;
;;; A shell was copied on its own, without its text. A shell with nothing to
;;; enclose is meaningless, so the copy is queued for deletion.
;;; ---------------------------------------------------------------------------

(defun TextShell:ShellCopied ( owner reactor params )
    (if (/= 0 (car params))
        (progn
            (setq *TextShell:Pending* (append *TextShell:Pending* (list (car params))))
            (vlr-command-reactor "textshell-shellcopycmd"
               '(
                    (:vlr-commandended     . TextShell:ShellCopyEnded)
                    (:vlr-commandcancelled . TextShell:CommandCancelled)
                    (:vlr-commandfailed    . TextShell:CommandCancelled)
                )
            )
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:ShellCopyEnded     [ reactor callback ]
;;;
;;; Deletes the orphaned copy. The type is verified first so that a queue
;;; entry which somehow refers to something else cannot cause the wrong
;;; object to be erased.
;;; ---------------------------------------------------------------------------

(defun TextShell:ShellCopyEnded ( reactor params / ent )
    (vlr-remove reactor)
    (if (and (setq ent (car *TextShell:Pending*))
             (member (cdr (assoc 0 (entget ent))) '("CIRCLE" "LWPOLYLINE"))
        )
        (entdel ent)
    )
    (setq *TextShell:Pending* (cdr *TextShell:Pending*))
    (princ)
)

;;; ===========================================================================
;;;                          G E O M E T R Y
;;; ===========================================================================

;;; ---------------------------------------------------------------------------
;;; TextShell:Create
;;;
;;; Builds the shell entity around the given text and returns its entity
;;; name, with the pairing xdata already attached.
;;;
;;;   enx - the text's entity data list
;;;   typ - "CIRCLE", "SLOT", "RECTANGLE" or "FILLETED"
;;;   off - offset factor, as a multiple of the text height
;;;
;;; Returns nil if the text extents could not be measured.
;;; ---------------------------------------------------------------------------

(defun TextShell:Create ( enx typ off / lst )
    (cond
        ;;  No measurable extents, e.g. empty text.
        (   (null (setq lst (TextShell:Extents enx (* off (cdr (assoc 40 enx))))))
            nil
        )

        ;;  ---- circle through the box corners ----
        ;;  Centred on the box centre with a radius of half its diagonal, so
        ;;  the text is fully enclosed whatever its proportions.
        (   (= "CIRCLE" typ)
            (entmakex
                (list
                   '(0 . "CIRCLE")
                    (cons 10 (TextShell:Mid (car lst) (caddr lst)))
                    (cons 40 (/ (distance (car lst) (caddr lst)) 2.0))
                    (assoc 210 enx)                  ;; same extrusion as the text
                    (list -3
                        (list *TextShell:App*
                           '(1002 . "{")
                            (cons 1005 (cdr (assoc 5 enx)))   ;; the text's handle
                           '(1000 . "CIRCLE")
                            (cons 1040 off)
                           '(1002 . "}")
                        )
                    )
                )
            )
        )

        ;;  ---- everything else is a closed lightweight polyline ----
        (   t
            (entmakex
                (append
                    (list
                       '(000 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                        ;; A filleted box needs two vertices per corner --
                        ;; one where the arc starts and one where it ends.
                        (if (= "FILLETED" typ) '(090 . 8) '(090 . 4))
                       '(070 . 1)                                ;; closed
                        (cons 38 (caddar lst))                   ;; elevation
                    )
                    (if (= "FILLETED" typ)
                        (TextShell:FilletCorners lst (* off (cdr (assoc 40 enx))))
                        (apply 'append
                            (mapcar
                               '(lambda ( pt bulge )
                                    (list (list 10 (car pt) (cadr pt)) (cons 42 bulge))
                                )
                                lst
                                ;; A slot is the same four corners as a
                                ;; rectangle, but with a bulge of 1 (a
                                ;; half-circle) on the two end edges.
                                (if (= "SLOT" typ)
                                   '(0.0 1.0 0.0 1.0)
                                   '(0.0 0.0 0.0 0.0)
                                )
                            )
                        )
                    )
                    (list (assoc 210 enx)
                        (list -3
                            (list *TextShell:App*
                               '(1002 . "{")
                                (cons 1005 (cdr (assoc 5 enx)))
                                (cons 1000 typ)
                                (cons 1040 off)
                               '(1002 . "}")
                            )
                        )
                    )
                )
            )
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; TextShell:Rebuild
;;;
;;; Resizes and repositions an existing shell to match its text.
;;;
;;; The shell's own reactor is detached for the duration. Without that, the
;;; entmod below would fire the shell's modified callback, which would queue
;;; another rebuild, which would fire it again -- an endless loop. It is
;;; reattached in every exit path, including the one where the extents could
;;; not be measured.
;;;
;;;   enx - the text's entity data
;;;   typ - shape name
;;;   off - offset factor
;;;   box - the shell's current entity data
;;; ---------------------------------------------------------------------------

(defun TextShell:Rebuild ( enx typ off box / lst )

    (if (= 'vlr-object-reactor (type *TextShell:ShellReactor*))
        (vlr-remove *TextShell:ShellReactor*)
    )

    (cond
        (   (null (setq lst (TextShell:Extents enx (* off (cdr (assoc 40 enx))))))
            nil
        )

        (   (= "CIRCLE" typ)
            ;; Three nested substitutions replace centre, radius and
            ;; extrusion in one entmod.
            (entmod
                (subst (cons 10 (TextShell:Mid (car lst) (caddr lst)))
                       (assoc 10 box)
                    (subst (cons 40 (/ (distance (car lst) (caddr lst)) 2.0))
                           (assoc 40 box)
                        (subst (assoc 210 enx) (assoc 210 box) box)
                    )
                )
            )
        )

        (   t
            ;; A polyline's vertex count can change (four corners to eight
            ;; and back), so the vertex data cannot be substituted in place.
            ;; Instead the header is kept up to and including group 38 and
            ;; entirely new vertex data is appended. The double reverse is
            ;; what truncates the list at that point.
            (entmod
                (append
                    (subst (cons 38 (caddar lst))
                           (assoc 38 box)
                           (reverse (member (assoc 38 box) (reverse box)))
                    )
                    (if (= "FILLETED" typ)
                        (TextShell:FilletCorners lst (* off (cdr (assoc 40 enx))))
                        (apply 'append
                            (mapcar
                               '(lambda ( pt bulge )
                                    (list (list 10 (car pt) (cadr pt)) (cons 42 bulge))
                                )
                                lst
                                (if (= "SLOT" typ)
                                   '(0.0 1.0 0.0 1.0)
                                   '(0.0 0.0 0.0 0.0)
                                )
                            )
                        )
                    )
                    (list (assoc 210 enx))
                )
            )
        )
    )

    (if (= 'vlr-object-reactor (type *TextShell:ShellReactor*))
        (vlr-add *TextShell:ShellReactor*)
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:FilletCorners
;;;
;;; Turns four rectangle corners into the eight vertices of a rounded
;;; rectangle, complete with bulges.
;;;
;;; At each corner, the straight edge stops short by the fillet radius, an
;;; arc turns the 90 degree corner, and the next straight edge begins. So
;;; each corner becomes two vertices: the arc's start, carrying the bulge,
;;; and the arc's end, carrying no bulge.
;;;
;;; The bulge value is the square root of two minus one. Bulge is defined as
;;; the tangent of a quarter of the arc's included angle; for a 90 degree
;;; corner that is tan(22.5 degrees), which is exactly sqrt(2) - 1.
;;;
;;; The offsets are expressed in the rectangle's own axes and rotated by the
;;; angle of its bottom edge, so rounded corners come out correct on text at
;;; any rotation.
;;;
;;;   lst - the four corner points, anticlockwise from lower left
;;;   rad - fillet radius
;;; ---------------------------------------------------------------------------

(defun TextShell:FilletCorners ( lst rad / blg mat rot )
    (setq blg (1- (sqrt 2.0))
          rot (angle (car lst) (cadr lst))          ;; angle of the bottom edge
          mat (list (list (cos rot) (sin (- rot)))
                    (list (sin rot) (cos rot))
              )
    )
    (apply 'append
        (mapcar
           '(lambda ( pt pair )
                (apply 'append
                    (mapcar
                       '(lambda ( vec bulge )
                            (list
                                (cons 10 (mapcar '+ pt (TextShell:MxV mat vec)))
                                (cons 42 bulge)
                            )
                        )
                        pair (list blg 0.0)
                    )
                )
            )
            lst
            ;; For each corner: where the arc starts, then where it ends.
            ;; Read anticlockwise -- lower left, lower right, upper right,
            ;; upper left.
            (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)))
            )
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; TextShell:Extents
;;;
;;; Returns the four corners of the offset box around a text object, in world
;;; coordinates, anticlockwise from lower left.
;;;
;;; TEXT and MTEXT need completely different treatment:
;;;
;;;   TEXT   the built-in textbox function measures the glyphs themselves,
;;;          accounting for style, width factor and oblique angle, and
;;;          returns the box relative to the insertion point.
;;;
;;;   MTEXT  has no equivalent, so the box is built from the stored width
;;;          (group 42) and height (group 43). Where those sit relative to
;;;          the insertion point depends on the attachment point (group 71),
;;;          which runs 1 to 9 from top-left to bottom-right; the origin
;;;          offset is worked out from it.
;;;
;;; In both cases the box is then rotated to the text's own angle and
;;; translated to the text's position.
;;;
;;;   enx - text entity data
;;;   off - offset distance in drawing units
;;; ---------------------------------------------------------------------------

(defun TextShell:Extents ( enx off / base box hgt jst nrm org rot wid )
    (if
        (setq box
            (cond
                (   (= "TEXT" (cdr (assoc 0 enx)))
                    (setq base (cdr (assoc 10 enx))
                          rot  (cdr (assoc 50 enx))
                          box  (textbox enx)
                    )
                    (list
                        (list (- (caar  box) off) (- (cadar  box) off))
                        (list (+ (caadr box) off) (- (cadar  box) off))
                        (list (+ (caadr box) off) (+ (cadadr box) off))
                        (list (- (caar  box) off) (+ (cadadr box) off))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 0 enx)))
                    (setq nrm  (cdr (assoc 210 enx))
                          base (trans (cdr (assoc 10 enx)) 0 nrm)
                          ;; Group 11 is the X-axis direction vector, whose
                          ;; angle is the MText rotation.
                          rot  (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 nrm))
                          wid  (cdr (assoc 42 enx))
                          hgt  (cdr (assoc 43 enx))
                          jst  (cdr (assoc 71 enx))
                          org
                          (list
                              ;; Horizontal: 1,4,7 left; 2,5,8 centred;
                              ;; 3,6,9 right.
                              (cond
                                  ((member jst '(2 5 8)) (/ wid -2.0))
                                  ((member jst '(3 6 9)) (- wid))
                                  (0.0)
                              )
                              ;; Vertical: 1,2,3 top; 4,5,6 middle;
                              ;; 7,8,9 bottom.
                              (cond
                                  ((member jst '(1 2 3)) (- hgt))
                                  ((member jst '(4 5 6)) (/ hgt -2.0))
                                  (0.0)
                              )
                          )
                    )
                    (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))
                    )
                )
            )
        )
        ;; Rotate to the text's angle, then translate to its position.
        (   (lambda ( mat )
                (mapcar '(lambda ( pt ) (mapcar '+ (TextShell:MxV mat pt) base)) box)
            )
            (list
                (list (cos rot) (sin (- rot)) 0.0)
                (list (sin rot) (cos rot)     0.0)
               '(0.0 0.0 1.0)
            )
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; TextShell:Mid
;;;
;;; Returns the midpoint of two points, of any dimension.
;;; ---------------------------------------------------------------------------

(defun TextShell:Mid ( a b )
    (mapcar '(lambda ( x y ) (/ (+ x y) 2.0)) a b)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:MxV
;;;
;;; Multiplies a matrix by a vector: each row is dotted with the vector.
;;; ---------------------------------------------------------------------------

(defun TextShell:MxV ( m v )
    (mapcar '(lambda ( row ) (apply '+ (mapcar '* row v))) m)
)

;;; ---------------------------------------------------------------------------
;;; TextShell:UnlockLayers
;;;
;;; Unlocks every locked layer and returns the list of what was unlocked, so
;;; the exact original state can be restored. Layers already unlocked are
;;; never touched.
;;; ---------------------------------------------------------------------------

(defun TextShell:UnlockLayers ( / lck )
    (vlax-for lay (vla-get-layers (TextShell:Doc))
        (if (= :vlax-true (vla-get-lock lay))
            (progn
                (vla-put-lock lay :vlax-false)
                (setq lck (cons lay lck))
            )
        )
    )
    lck
)

;;; ---------------------------------------------------------------------------
;;; TextShell:StripData
;;;
;;; Removes this program's xdata from an entity.
;;;
;;; Supplying the application name with no data after it is how AutoCAD is
;;; told to delete that application's xdata; other applications' xdata on the
;;; same object is untouched.
;;;
;;; Group 40 is dropped for text objects, for the same reason as when the
;;; data is added: re-applying the height through entmod can rescale MText.
;;; ---------------------------------------------------------------------------

(defun TextShell:StripData ( ent / enx )
    (setq enx (entget ent))
    (if (member (cdr (assoc 0 enx)) '("TEXT" "MTEXT"))
        (entmod (append (vl-remove (assoc 40 enx) enx)
                        (list (list -3 (list *TextShell:App*)))))
        (entmod (append enx (list (list -3 (list *TextShell:App*)))))
    )
)

;;; ===========================================================================
;;;                    L O A D - T I M E   S E T U P
;;; ===========================================================================
;;;
;;; Reactors do not survive between drawings, so every time this file is
;;; loaded the existing pairings are found from their xdata and put back
;;; under watch.
;;;
;;; Any reactor this program left behind is removed first. Reloading the file
;;; would otherwise leave duplicate reactors running, which would rebuild
;;; each shell several times per edit.
;;;
;;; The reactor data is type-checked before being pattern-matched: another
;;; application may have attached reactors whose data is not a string, and
;;; wcmatch on a non-string raises an error that would abort the load.
;;;
;;; Everything runs inside an anonymous lambda so no temporary symbols are
;;; left defined afterwards.
;;; ---------------------------------------------------------------------------

(   (lambda ( / ent idx lck obj sel shells texts )

        ;; Layers are unlocked because vlr-object-reactor refuses to attach
        ;; to an object on a locked layer, which would silently leave those
        ;; pairings dead.
        (setq lck (TextShell:UnlockLayers))

        (foreach group (vlr-reactors :vlr-object-reactor :vlr-command-reactor)
            (foreach vlr (cdr group)
                (if (and (= 'str (type (vlr-data vlr)))
                         (wcmatch (vlr-data vlr) "textshell-*")
                    )
                    (vlr-remove vlr)
                )
            )
        )

        (if (setq sel (ssget "_X" (list '(0 . "TEXT,MTEXT,CIRCLE,LWPOLYLINE")
                                       (list -3 (list *TextShell:App*)))))
            (progn
                ;; Sort what was found into texts and shells, so each goes to
                ;; the right reactor.
                (repeat (setq idx (sslength sel))
                    (setq ent (ssname sel (setq idx (1- idx)))
                          obj (vlax-ename->vla-object ent)
                    )
                    (if (member (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT"))
                        (setq texts  (cons obj texts))
                        (setq shells (cons obj shells))
                    )
                )
                (if texts
                    (vlr-set-notification
                        (setq *TextShell:TextReactor*
                            (vlr-object-reactor texts "textshell-text"
                               '(
                                    (:vlr-modified . TextShell:TextChanged)
                                    (:vlr-copied   . TextShell:TextCopied)
                                )
                            )
                        )
                        'active-document-only
                    )
                )
                (if shells
                    (vlr-set-notification
                        (setq *TextShell:ShellReactor*
                            (vlr-object-reactor shells "textshell-shell"
                               '(
                                    (:vlr-modified . TextShell:ShellChanged)
                                    (:vlr-copied   . TextShell:ShellCopied)
                                )
                            )
                        )
                        'active-document-only
                    )
                )
            )
        )

        (foreach lay lck (vla-put-lock lay :vlax-true))
        (setq *TextShell:Pending* nil)
        (princ)
    )
)

(princ "\nTextShell loaded. TEXTSHELL to enclose text, UNSHELL to unlink.")
(princ)

;;; ---------------------------------------------------------------------------
;;; End of file
;;; ---------------------------------------------------------------------------