;;----------------------=={ 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,TCH_TEXT")) "选择要关联外框的文字:" "没有找到文字.")
			)
		all (mai_remove_tchtxt all nil)
		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 val (cdar (mai_dxf -3 (entget (vlax-vla-object->ename owner) (list lm_tbox_app)))))
		(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 val (cdar (mai_dxf -3 (entget (vlax-vla-object->ename box) (list lm_tbox_app)))))
		(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))
				(mai_unlock_layers lck)
				(or (wcmatch (strcase m t) "*cancel*,*exit*")
					(princ (strcat "\nError: " m))
				)
				(princ)
			)
		)
		(vl-load-com)
		(setq lck (mai_unlock_alllayer))
		(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))
		(mai_relock_layers lck)
		(setq tbox:owner nil)
		(princ)
	)
)

(princ)

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