draws a box around selected text based on a user defined offset factor

;| TBOX.lsp draws a box around selected text based on a user defined offset factor.
   Written and Tested in R2000.
   Version 1.2 - by Tippit CADD Services
   Version 1.3 - by pd
------------------------------------------------------------------------
------------------------------------------------------------------------
 Created by J. Tippit, SPAUG President
    E-mail: jefft@wilkersonproperties.com
    Web Site: http://www.spaug.org

------------------------------------------------------------------------
------------------------------------------------------------------------

 Revisions:
1.0 Originally created ?
1.1 Added scale factor prompt & entity verification 10/21/99
1.2 Added MTEXT support, osmode handling, error trapping 11/26/99
1.3 Added MTEXT angle-support, replacement scale with offset 12/29/00
|;

;----------------------------------------------------------------------
; Error Handler
;----------------------------------------------------------------------
(defun tboxerr (s)
   (if (not (member s '("console break" "Function cancelled")))
      (princ (strcat "\nError: " s "\nResetting Variables."))
   )
   (setvar "osmode" OSM)
   (command "._undo" "e")
   (setvar "cmdecho" 1)
   (setq *error* tboxolderr)
   (princ)
)
;----------------------------------------------------------------------
; Main Program
;----------------------------------------------------------------------
(defun C:TBOX ( / E1 TB LL UR UL LR EL PT APT WDT HGT PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9)
   (setq tboxolderr *error* *error* tboxerr)
   (setvar "cmdecho" 0)
   (command "._undo" "be")
   (setq OSM (getvar "osmode"))
   (setvar "osmode" 0)
   (setq TE nil)
   (while (not TE)
      (progn
         (setq TE (car (entsel "\nSelect Text or MText: ")))
         (if TE
            (progn
               (setq E1 (entget TE))
               (if (= (cdr (assoc 0 E1)) "TEXT")
                  (progn
                     (if (or (= SF nil)(= SF ""))(setq SF "1.5"))
                     (setq SF "0.12")
    (setq SF2 SF)
                     (if (or (= SF nil)(= SF ""))(setq SF SF2))
                     (command "ucs" "Entity" TE)
                     (setq TB (textbox (list (cons -1 TE)))
                           LL (car TB)
                           UR (cadr TB)
                           UL (list (car LL) (cadr UR))
                           LR (list (car UR) (cadr LL))
                     )
                     (command "._pline" LL LR UR UL "c")
                     (setq EL (entlast))
                     (setq PT (list (+ (car UL) 1000) (+ (cadr UL) 1000)))
                     (command "._offset" SF EL PT "")
    (entdel EL)
    (command "ucs" "w")
                  )
                  (progn
                     (if (= (cdr (assoc 0 E1)) "MTEXT")
                        (progn
                           (if (or (= SF nil)(= SF ""))(setq SF "1.5"))
  (setq SF "0.12")
                           (setq SF2 SF)
                           (if (or (= SF nil)(= SF ""))(setq SF SF2))  
                           (setq APT (cdr (assoc 71 E1))) ; attachment point
                           (setq WDT (cdr (assoc 42 E1))) ; width
                           (setq HGT (cdr (assoc 43 E1))) ; height
                           (setq PT7 (cdr (assoc 10 E1))) ; insertion point
                           (setq PT9 (list (+ (car PT7) WDT) (cadr PT7) (caddr PT7)))
                           (setq PT3 (list (car PT9) (+ (cadr PT9) HGT) (caddr PT9)))
                           (setq PT1 (list (car PT7) (+ (cadr PT7) HGT) (caddr PT7)))

                           (command "._pline" PT7 PT9 PT3 PT1 "c")
                           (setq EL (entlast))
                         
  (command "._move" EL "" PT1 PT7)
  (command "._rotate" "last" "" (list (car pt7)(cadr pt7))(/(*(cdr (assoc 50 E1))180)pi))
                           (command "._offset" SF EL PT7 "")
  (entdel EL)
                        )
                        (progn
                           (setq TE nil)
                           (prompt "\nSelected object is not TEXT or MTEXT. Try again. ")
                        )
                     )
                  )
               )
            )
            (prompt "\nMissed. Try again.")
         )
      )
   )
 
   (command "._erase" EL "")
   (if (= (cdr (assoc 0 E1)) "TEXT")(command "ucs" "w"))
   (redraw)
   (setvar "osmode" OSM)
   (command "_undo" "e")
   (setvar "cmdecho" 1)
   (setq *error* tboxolderr)
   (princ)
)
(prompt (strcat "\nCopyright \251 TCS 1999 Version 1.3 - Text Box Routine loaded."))
(prompt "\nType TBOX to execute.")
(princ)