;;----------------------=={ Associative Textbox }==---------------------;;
;;                                                                      ;;
;;  ----------------------------------                                  ;;
;;  Program Overview                                                    ;;
;;  ----------------------------------                                  ;;
;;                                                                      ;;
;;  This program enables the user to create an associative textbox      ;;
;;  surrounding a Text or MText object in the drawing. The size,        ;;
;;  position, orientation & rotation of the resulting textbox will      ;;
;;  be automatically updated following modification to the associated   ;;
;;  Text or MText object.                                               ;;
;;                                                                      ;;
;;  The user may create an associative textbox by issuing the 'tbox'    ;;
;;  command at the AutoCAD command-line. Upon calling the program, the  ;;
;;  user is prompted to specify an Offset Factor for the textbox, and   ;;
;;  the shape of the textbox to be created.                             ;;
;;                                                                      ;;
;;  The Offset Factor controls the dimensions of the textbox relative   ;;
;;  to the size of the associated annotation object and is a function   ;;
;;  of the text height. To provide an example, specifying an Offset     ;;
;;  Factor of 0.35 will result in a textbox which is offset from the    ;;
;;  text object by 0.35 multiplied by the text height of the object.    ;;
;;                                                                      ;;
;;  Upon entering a valid Offset Factor, the user may choose from       ;;
;;  three types of textbox: Circle, Rectangle or Slot. The circular     ;;
;;  textbox will have diameter equal to the length of the diagonal of   ;;
;;  the rectangular textbox. The Slot textbox will have dimensions      ;;
;;  equal to the rectangular textbox, however, the vertical edges       ;;
;;  (relative to the text object) will be semi-circular.                ;;
;;                                                                      ;;
;;  The program will remember the previously used settings for both     ;;
;;  the offset factor & textbox type, and these settings will be        ;;
;;  available as default options at both prompts throughout the active  ;;
;;  drawing session.                                                    ;;
;;                                                                      ;;
;;  The user will then be prompted to select either a Text or MText     ;;
;;  object to enclose with the textbox. At this prompt the user will    ;;
;;  be notified if the selected Text or MText object already possesses  ;;
;;  an associative textbox.                                             ;;
;;                                                                      ;;
;;  Textbox associativity may be removed at any time using by issuing   ;;
;;  the 'rtbox' (Remove Textbox) command at the AutoCAD command-line.   ;;
;;  When called, the user is prompted to select either a text or        ;;
;;  textbox object to remove the associativity between the pair. At     ;;
;;  this prompt the user also has the option to remove associativity    ;;
;;  from all textboxes in the drawing.                                  ;;
;;                                                                      ;;
;;  Note that this program will only remove the associative nature of   ;;
;;  the textbox - the user may subsequently delete the text or textbox  ;;
;;  object if required.                                                 ;;
;;                                                                      ;;
;;  ----------------------------------                                  ;;
;;  Associative Behaviour                                               ;;
;;  ----------------------------------                                  ;;
;;                                                                      ;;
;;  The program utilises a combination of Object Reactors & Command     ;;
;;  Reactors to monitor modification events to either the annotation    ;;
;;  object or surrounding textbox and will update either object         ;;
;;  accordingly.                                                        ;;
;;                                                                      ;;
;;  If the annotation object (Text or MText) is modified, the           ;;
;;  surrounding textbox will be automatically updated to reflect the    ;;
;;  modifications.                                                      ;;
;;                                                                      ;;
;;  If the textbox is modified the program will automatically revert    ;;
;;  all modifications applied to the textbox so as to retain the        ;;
;;  correct size & position relative to the associated annotation       ;;
;;  object.                                                             ;;
;;                                                                      ;;
;;  If the annotation object is copied, the associative textbox will    ;;
;;  also be copied and will form a new pair of associative text &       ;;
;;  textbox objects.                                                    ;;
;;                                                                      ;;
;;  If either annotation object or textbox are erased during the        ;;
;;  drawing session, the textbox associativity will not be lost until   ;;
;;  the drawing is closed. This enables the user to retain textbox      ;;
;;  associativity following an undo of the erase operation.             ;;
;;                                                                      ;;
;;  All associative data is stored within the Extended Entity Data      ;;
;;  (xData) of both the annotation object and associated textbox        ;;
;;  object. This xData is removed upon using the 'rtbox' command on a   ;;
;;  text & textbox pair.                                                ;;
;;                                                                      ;;
;;  The use of xData enables the retention of textbox associativity     ;;
;;  between drawing sessions by rebuilding the required reactors        ;;
;;  based on the available xData when the program is loaded.            ;;
;;                                                                      ;;
;;  Please note that this program will need to be loaded to enable      ;;
;;  associative behaviour for existing textbox objects in a drawing.    ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    30-04-2013                                      ;;
;;                                                                      ;;
;;  First release.                                                      ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    30-04-2013                                      ;;
;;                                                                      ;;
;;  Fixed bug causing the program to crash during loading if reactors   ;;
;;  whose reactor data is of a data type other than string are already  ;;
;;  running in the active drawing session.                              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    01-05-2013                                      ;;
;;                                                                      ;;
;;  Fixed bug causing MText & LWPolyline objects residing in Paperspace ;;
;;  layouts to be transferred to Modelspace.                            ;;
;;----------------------------------------------------------------------;;

(setq lm_tbox_app "LMAC_TBOX") ;; AppID
(or lm_tbox_off (setq lm_tbox_off 0.3))
(or lm_tbox_typ (setq lm_tbox_typ "Rectangle"))

;(setq ent (car(entsel)))



;;----------------------------------------------------------------------;;
;;  c:tbox  -  Create associative textbox                               ;;
;;----------------------------------------------------------------------;;
;ÎÄ×Ö¹ØÁªÍâ¿ò[lm_tbox]V1-2.lsp
(defun c:lm_tbox ( / old_cmd tt all tbox:textadd tbox:textdel)

(defun tbox:textadd ( ent / box enx )
 (and
    ent
    (setq enx (entget ent))
    (progn (regapp lm_tbox_app)
           (setq box (tbox:createbox enx (strcase lm_tbox_typ) lm_tbox_off))
    )
    (progn
        (entmod
            (append (vl-remove (assoc 40 enx) enx)
                (list
                    (list -3
                        (list lm_tbox_app '(1002 . "{") (cons 1005 (mai_dxf 5 box))
                              (cons 1000 (strcase lm_tbox_typ)) (cons 1040 lm_tbox_off) '(1002 . "}")
                        )
                    )
                )
            )
        )
        (if (= 'vlr-object-reactor (type tbox:textreactor))
            (vlr-owner-add tbox:textreactor (vlax-ename->vla-object ent))
            (vlr-set-notification
                (setq tbox:textreactor
                     (vlr-object-reactor
                           (list (vlax-ename->vla-object ent))
                           "tbox-textreactor"
                           '( (:vlr-modified . tbox:textcallback) (:vlr-copied . tbox:textcopied))
                     )
                )
               'active-document-only
            )
        )
        (if (= 'vlr-object-reactor (type tbox:tboxreactor))
            (vlr-owner-add tbox:tboxreactor (vlax-ename->vla-object box))
            (vlr-set-notification
                (setq tbox:tboxreactor
                     (vlr-object-reactor
                          (list (vlax-ename->vla-object box))
                          "tbox-tboxreactor"
                           '( (:vlr-modified . tbox:tboxcallback) (:vlr-copied . tbox:tboxcopied))
                     )
                )
                'active-document-only
            )
        )
    )
 )
)


(defun tbox:textdel ( ent / box bob obj enx )
 (if 
 (and
    ent
    (setq enx (entget ent (list lm_tbox_app)))
    (assoc -3 enx)
    (vlax-write-enabled-p (setq obj (vlax-ename->vla-object ent)))
    (setq box (handent (mai_dxf 1005 (cdar (mai_dxf -3 enx)))))
    (progn
        (setq bob (vlax-ename->vla-object box))
        (tbox:removeowner obj)
        (tbox:removexdata ent)
        (if bob (tbox:removeowner bob))
        (and box (entget box) (tbox:removexdata box))
        T
    )
 )
 box
 )
)

    (mini_start nil)
    (while
        (progn
            (princ (strcat "\nµ±Ç°ÎÄ×ÖÍâ¿òÀàÐÍ¡¾"
                           (cond ((= lm_tbox_typ "Circle") "Ô°")
                                 ((= lm_tbox_typ "Slot") "¾ØÐÎÁ½¶Ë¼ÓÔ²")
                                 ((= lm_tbox_typ "Rectangle") "¾ØÐÎ")
                           )
                          "¡¿,ÍâÆ«ÒÆÏµÊý¡¾"
                           (rtos lm_tbox_off 2 2) "¡¿."
                   )
           )
           (initget "Circle Slot Rectangle D O")
           (progn (setq tt (getkword "\n[Ô°(C)/¾ØÐÎÁ½¶Ë¼ÓÔ²(S)/¾ØÐÎ(R)/È¥³ýÎÄ×Ö»òÍâ¿ò¹ØÁª(D)/ÍâÆ«ÒÆÏµÊý(O)]:<»Ø³µÑ¡ÔñÉú³É¹ØÁªÍâ¿òÎÄ×Ö>"))
                  (member tt (list "Circle" "Slot" "Rectangle" "O"))
           )
        )
        (if (= tt "O")
            (setq lm_tbox_off (cond ((getdist (strcat "\nÎÄ×ÖÍâ¿òÍùÍâÆ«ÒÆÏµÊý : <" (rtos lm_tbox_off 2 2) ">")))
                                    (lm_tbox_off)
                              )
            )
            (setq lm_tbox_typ tt)
        )
    )
    (setq all
        (if tt
            (mai_select_first
                      (list '(0 . "TEXT,MTEXT,CIRCLE,LWPOLYLINE") (list -3 (list lm_tbox_app)))
                      "Ñ¡ÔñÒªÈ¥³ý¹ØÁªµÄÎÄ×Ö»òÍâ¿ò:"
                      "Ã»ÓÐÕÒµ½ÎÄ×Ö»òÍâ¿ò."
            )
            (mai_select_first (list '(0 . "TEXT,MTEXT")) "Ñ¡ÔñÒª¹ØÁªÍâ¿òµÄÎÄ×Ö:" "Ã»ÓÐÕÒµ½ÎÄ×Ö.")
        )
        all (mai_ssget_2_list all)
    )
    (or all (exit))
    (if tt
        (while all
            (setq tt (car all) all (cdr all))
            (if (setq tt (tbox:textdel tt))
                (setq all (vl-remove tt all))
            )
        )
        (mapcar 'tbox:textadd all)
    )
    (mai_end)
)


;;----------------------------------------------------------------------;;
;;                           Support Functions                          ;;
;;----------------------------------------------------------------------;;

(defun tbox:textcallback ( owner reactor params / ent enx typ val )
    (and
        (vlax-read-enabled-p owner)
        (progn (vla-getxdata owner lm_tbox_app 'typ 'val) val)
        (setq val (mapcar 'cons (vlax-safearray->list typ) (mapcar 'vlax-variant-value (vlax-safearray->list val))))
        (setq ent (handent (mai_dxf 1005 val)))
        (setq enx (entget ent))
        (vlax-write-enabled-p (vlax-ename->vla-object ent))
        (if (= "AcDbMText" (vlax-get-property owner 'objectname)) ;; MText DXF data is not immediately updated after mtedit
            (tbox:tboxcallback (vlax-ename->vla-object ent) nil nil)
            (tbox:updatebox (entget (vlax-vla-object->ename owner)) (mai_dxf 1000 val) (mai_dxf 1040 val) enx)
        )
    )
    (princ)
)

(defun tbox:textcopied ( owner reactor params )
    (or (= 0 (car params))
        (progn
            (setq tbox:owner (append tbox:owner (list (car params))))
            (vlr-command-reactor "tbox-textcopiedcommreactor"
               '(   (:vlr-commandended     . tbox:textcopiedcommandended)
                    (:vlr-commandcancelled . tbox:textcopiedcommandcancelled)
                    (:vlr-commandfailed    . tbox:textcopiedcommandcancelled)
                )
            )
        )
    )
    (princ)
)

(defun tbox:textcopiedcommandended ( reactor params / box ent enx val )
    (vlr-remove reactor)
     (and
        (setq ent (car tbox:owner))
        (setq enx (entget ent (list lm_tbox_app)))
        (member (mai_dxf 0 enx) '("TEXT" "MTEXT"))
        (setq val (cdadr (assoc -3 enx)))
        (setq box (tbox:createbox enx (mai_dxf 1000 val) (mai_dxf 1040 val)))
        (progn
            (entmod
                (append (vl-remove (assoc 40 enx) (entget ent))
                    (list
                        (list -3
                            (list lm_tbox_app
                               '(1002 . "{")
                                (cons  1005 (mai_dxf 5 box))
                                (assoc 1000 val)
                                (assoc 1040 val)
                               '(1002 . "}")
                            )
                        )
                    )
                )
            )
            (if (= 'vlr-object-reactor (type tbox:textreactor))
                (vlr-owner-add tbox:textreactor (vlax-ename->vla-object ent))
            )
            (if (= 'vlr-object-reactor (type tbox:tboxreactor))
                (vlr-owner-add tbox:tboxreactor (vlax-ename->vla-object box))
            )                    
        )            
    )
    (setq tbox:owner (cdr tbox:owner))
    (princ)
)

(defun tbox:textcopiedcommandcancelled ( reactor params )
    (vlr-remove reactor)
    (setq tbox:owner nil)
    (princ)
)

(defun tbox:tboxcallback ( owner reactor params )
    (setq tbox:owner (cons owner tbox:owner))
    (vlr-command-reactor "tbox-commreactor"
       '(   (:vlr-commandended     . tbox:commandended)
            (:vlr-commandcancelled . tbox:commandcancelled)
            (:vlr-commandfailed    . tbox:commandcancelled)
        )
    )
    (princ)
)

(defun tbox:commandended ( reactor params / box txt typ val )
    (vlr-remove reactor)
    (and (setq box (car tbox:owner))
         (vlax-read-enabled-p  box)
         (vlax-write-enabled-p box)
         (progn (vla-getxdata  box lm_tbox_app 'typ 'val) val)
         (setq val (mapcar 'cons (vlax-safearray->list typ) (mapcar 'vlax-variant-value (vlax-safearray->list val))))
         (setq txt (entget (handent (mai_dxf 1005 val))))
         (tbox:updatebox txt (mai_dxf 1000 val) (mai_dxf 1040 val) (entget (vlax-vla-object->ename box)))
    )
    (setq tbox:owner (cdr tbox:owner))
    (princ)
)

(defun tbox:commandcancelled ( reactor params )
    (vlr-remove reactor)
    (setq tbox:owner nil)
    (princ)
)

(defun tbox:tboxcopied ( owner reactor params )
    (or (= 0 (car params))
        (progn
            (setq tbox:owner (append tbox:owner (list (car params))))
            (vlr-command-reactor "tbox-tboxcopiedcommreactor"
               '(   (:vlr-commandended     . tbox:tboxcopiedcommandended)
                    (:vlr-commandcancelled . tbox:tboxcopiedcommandcancelled)
                    (:vlr-commandfailed    . tbox:tboxcopiedcommandcancelled)
                )
            )            
        )
    )
    (princ)
)

(defun tbox:tboxcopiedcommandended ( reactor params / ent )
    (vlr-remove reactor)
    (and (setq ent (car tbox:owner))
         (member (mai_dxf 0 ent) '("CIRCLE" "LWPOLYLINE"))
         (entdel ent)
    )
    (setq tbox:owner (cdr tbox:owner))
    (princ)
)

(defun tbox:tboxcopiedcommandcancelled ( reactor params )
    (vlr-remove reactor)
    (setq tbox:owner nil)
    (princ)
)

(defun tbox:createbox ( enx typ off / lst )
    (if (setq lst (tbox:textbox enx (* off (mai_dxf 40 enx))))
        (if (= "CIRCLE" typ)
            (entmakex
                (list
                   '(0 . "CIRCLE")
                    (cons 10 (mai_divide_point (car lst) (caddr lst) 0.5))
                    (cons 40 (/ (distance (car lst) (caddr lst)) 2.0))
                    (assoc 210 enx)
                    (list -3 (list lm_tbox_app '(1002 . "{") (cons 1005 (mai_dxf 5 enx)) '(1000 . "CIRCLE") (cons 1040 off) '(1002 . "}")))
                )
            )
            (entmakex
                (append
                   '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1))
                    (list (cons 38 (caddar lst)))
                    (apply 'append
                        (mapcar
                            '(lambda ( a b ) (list (list 10 (car a) (cadr a)) (cons 42 b)))
                            lst
                            (if (= "SLOT" typ) '(0. 1. 0. 1.) '(0. 0. 0. 0.))
                        )
                    )
                    (list (assoc 210 enx)
                          (list -3 (list lm_tbox_app '(1002 . "{") (cons 1005 (mai_dxf 5 enx)) (cons 1000 typ) (cons 1040 off) '(1002 . "}")))
                    )                        
                )
            )
        )
    )
)

(defun tbox:updatebox ( enx typ off box / lst )
    (if (= 'vlr-object-reactor (type tbox:tboxreactor))
        (vlr-remove tbox:tboxreactor)
    )
    (if (setq lst (tbox:textbox enx (* off (mai_dxf 40 enx))))
        (if (= "CIRCLE" typ)
            (entmod
                (subst (cons  10 (mai_divide_point (car lst) (caddr lst) 0.5))
                       (assoc 10 box)
                       (subst (cons  40 (/ (distance (car lst) (caddr lst)) 2.0))
                              (assoc 40 box)
                              (subst (assoc 210 enx) (assoc 210 box) box)
                       )
                )
            )
            (entmod
                (append
                    (subst
                        (cons  38 (caddar lst))
                        (assoc 38 box)
                        (reverse (member (assoc 38 box) (reverse box)))
                    )
                    (apply 'append
                        (mapcar
                            '(lambda ( a b ) (list (list 10 (car a) (cadr a)) (cons 42 b)))
                            lst
                            (if (= "SLOT" typ) '(0. 1. 0. 1.) '(0. 0. 0. 0.))
                        )
                    )
                    (list (assoc 210 enx))
                )
            )
        )
    )
    (if (= 'vlr-object-reactor (type tbox:tboxreactor))
        (vlr-add tbox:tboxreactor)
    )
)

(defun tbox:unlocklayers ( / lck )
    (vlax-for lay (vlax-get-property (LM:acdoc) 'layers)
        (if (= :vlax-true (vlax-get-property lay 'lock))
            (progn
                (vlax-put-property lay 'lock :vlax-false)
                (setq lck (cons lay lck))
            )
        )
    )
    lck
)

(defun tbox:removexdata ( ent / enx )
    (setq enx (entget ent))
    (if (member (mai_dxf 0 enx) '("TEXT" "MTEXT"))
        (entmod (append (vl-remove (assoc 40 enx) enx) (list (list -3 (list lm_tbox_app)))))
        (entmod (append enx (list (list -3 (list lm_tbox_app)))))
    )
)

(defun tbox:removeowner ( obj )
    (if (wcmatch (vlax-get-property obj 'objectname) "AcDb*Text")
        (if (= 'vlr-object-reactor (type tbox:textreactor))
            (vlr-owner-remove tbox:textreactor obj)
        )
        (if (= 'vlr-object-reactor (type tbox:tboxreactor))
            (vlr-owner-remove tbox:tboxreactor obj)
        )
    )
)        
                                
;; The following function is based on code by gile

(defun tbox:textbox ( enx off / b h j l m n o p r w )
    (if
        (setq l
            (cond
                (   (= "TEXT" (mai_dxf 0 enx))
                    (setq b (mai_dxf 10 enx)
                          r (mai_dxf 50 enx)
                          l (textbox enx)
                    )
                    (list
                        (list (- (caar  l) off) (- (cadar  l) off))
                        (list (+ (caadr l) off) (- (cadar  l) off))
                        (list (+ (caadr l) off) (+ (cadadr l) off))
                        (list (- (caar  l) off) (+ (cadadr l) off))
                    )
                )
                (   (= "MTEXT" (mai_dxf 0 enx))
                    (setq n (mai_dxf 210 enx)
                          b (trans  (mai_dxf 10 enx) 0 n)
                          r (angle '(0.0 0.0 0.0) (trans (mai_dxf 11 enx) 0 n))
                          w (mai_dxf 42 enx)
                          h (mai_dxf 43 enx)
                          j (mai_dxf 71 enx)
                          o (list
                                (cond
                                    ((member j '(2 5 8)) (/ w -2.0))
                                    ((member j '(3 6 9)) (- w))
                                    (0.0)
                                )
                                (cond
                                    ((member j '(1 2 3)) (- h))
                                    ((member j '(4 5 6)) (/ h -2.0))
                                    (0.0)
                                )
                            )
                    )
                    (list
                        (list (- (car o)   off) (- (cadr o)   off))
                        (list (+ (car o) w off) (- (cadr o)   off))
                        (list (+ (car o) w off) (+ (cadr o) h off))
                        (list (- (car o)   off) (+ (cadr o) h off))
                    )
                )
            )
        )
        (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mai_mxv m p) b)) l))
            (list
                (list (cos r) (sin (- r)) 0.0)
                (list (sin r) (cos r)     0.0)
               '(0.0 0.0 1.0)
            )
        )
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vlax-get-property (vlax-get-acad-object) 'activedocument)))
    (LM:acdoc)
)

;;----------------------------------------------------------------------;;
;;                            Loading Function                          ;;
;;----------------------------------------------------------------------;;

(
    (lambda ( / *error* box ent inc lck obj sel txt )
        (setq *error*
           '(   ( m )
                (foreach lay lck (vla-put-lock lay :vlax-true))
                (or (wcmatch (strcase m t) "*cancel*,*exit*")
                    (princ (strcat "\nError: " m))
                )
                (princ)
            )
        )
        (vl-load-com)
        (setq lck (tbox:unlocklayers))
        (foreach typ (vlr-reactors :vlr-object-reactor :vlr-command-reactor)
            (foreach vlr (cdr typ)
                (and (= 'str (type (vlr-data vlr)))
                     (wcmatch (vlr-data vlr) "tbox-*reactor")
                     (vlr-remove vlr)
                )
            )
        )
        (if (setq sel (ssget "_X" (list '(0 . "TEXT,MTEXT,CIRCLE,LWPOLYLINE") (list -3 (list lm_tbox_app)))))
            (progn
                (repeat (setq inc (sslength sel))
                    (setq inc (1- inc)
                          ent (ssname sel inc)
                          obj (vlax-ename->vla-object ent)
                    )
                    (if (member (mai_dxf 0 ent) '("TEXT" "MTEXT"))
                        (setq txt (cons obj txt))
                        (setq box (cons obj box))
                    )
                )
                (if txt
                    (vlr-set-notification
                        (setq tbox:textreactor
                            (vlr-object-reactor txt "tbox-textreactor"
                               '(   (:vlr-modified . tbox:textcallback)
                                    (:vlr-copied   . tbox:textcopied)
                                )
                            )
                        )
                        'active-document-only
                    )
                )
                (if box
                    (vlr-set-notification
                        (setq tbox:tboxreactor
                            (vlr-object-reactor box "tbox-tboxreactor"
                               '(   (:vlr-modified . tbox:tboxcallback)
                                    (:vlr-copied   . tbox:tboxcopied)
                                )
                            )
                        )
                        'active-document-only
                    )
                )
            )
        )
        (foreach lay lck (vla-put-lock lay :vlax-true))
        (setq tbox:owner nil)
        (princ)
    )
)

(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;