I use this one for text boxes.
;| 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
05/23/03 Modified by Charles Alan Butler as follows
Added alternate boxes (Flat Oval & Hexagonal)
Ask for offset value only on the first box in each session
Check Pline width & prompt user if > 0
Loop until ESCAPE pressed
|;
;----------------------------------------------------------------------
; 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 BoxType
)
(setq tboxolderr *error*
*error* tboxerr
)
(setvar "cmdecho" 0)
(command "._undo" "be")
(setq OSM (getvar "osmode"))
(setvar "osmode" 0)
(setq TE nil
Plw (getvar "PlineWid") ; width of Poly Line
)
(if (/= Plw 0)
(Progn
(setq Plw (getint (strcat "Enter Pline Width <" (rtos Plw) ">:")))
(if (= Plw nil)
(Setq Plw 0)
)
(setvar "PlineWid" Plw)
)
)
;===================================================
(Setq BoxType "")
(initget 1 "Rectangle Flat Hexagon")
(setq BoxType
(getkword
"\n Type of box to use? (R)ectangle (F)lat Oval (H)exagon"
)
)
;===================================================
;(setq SF "1.5")
(setq SF (rtos (abs(getvar "offsetdist"))))
(setq SF2 SF)
(setq
SF (getstring
(strcat "\nEnter Offset TextFrame <" SF ">: ")
)
)
(if (or (= SF nil) (= SF ""))
(setq SF SF2)
)
;===================================================
(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
(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))
)
(if (= BoxType "Rectangle")
(command "._pline" LL LR UR UL "c")
)
(if (= BoxType "Flat")
(command "._pline" LL LR "a" UR "l" UR UL "a" LL "")
)
(if (= BoxType "Hexagon")
(progn
(setq d (/ (distance LR UR) 2)
d (sqrt (* (* d d) 2))
)
(command "._pline"
LL
LR
(polar LR (- (angle LR UR) 0.7854) d)
UR
UL
(polar UL (- (angle UL LL) 0.7854) d)
"c"
)
)
)
(setq EL (entlast))
(setq PT (list (+ (car UL) 1000) (+ (cadr UL) 1000)))
(command "._offset" SF EL PT "")
(entdel EL)
(command "ucs" "w")
(setq TE nil)
)
(progn
(if (= (cdr (assoc 0 E1)) "MTEXT")
(progn
(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))
)
(cond
((= BoxType "Rectangle")
(command "._pline" PT7 PT9 PT3 PT1 "c")
)
((= BoxType "Flat")
(command "._pline" PT7 PT9 "a" PT3 "l" PT3 PT1 "a"
PT7 "")
)
((= BoxType "Hexagon")
(progn
(setq d (/ (distance PT9 PT3) 2)
d (sqrt (* (* d d) 2))
)
(command "._pline"
PT7
PT9
(polar PT9 (- (angle PT9 PT3) 0.7854) d)
PT3
PT1
(polar PT1 (- (angle PT1 PT7) 0.7854) d)
"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)
(setq TE nil)
)
(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)
(setq SF nil)
(setvar "osmode" OSM)
(command "_undo" "e")
(setvar "cmdecho" 1)
(setq *error* tboxolderr)
(princ)
)
(prompt
(strcat
"\nCopyright \251 TCS 1999 Version 1.3 *-* CAB modified - Text Box Routine loaded."
)
)
(prompt "\nType TBOX to execute.")
(princ)