;Title - Erin Stephens Lisp Page
;Lisp Page from Internet - Internet Worldwide Communications
;************************************************************************
;*  Settext.lsp                                                         *
;*  Last updated: 02/22/90                                              *
;*  Description : Set the new font height and width by picking          *
;*                an existing text style in the drawing.                *
;*  Usage: SETTEXT                                                      *
;*  Variables:                                                          *
;*             lst  Entity association list                             *
;*             st   Style name of text                                  *
;*             ht   Height of text                                      *
;*             wf   Width factor of text                                *
;*             en   Entity to change text to                            *
;************************************************************************

(Defun c:SETTEXT (/ lst st ht wf en)  ;Define start of routine
 (setq e   nil                        ;Initialize variables
       ne  nil
       lst nil
       st  nil
       ht  nil
       wf  nil
       en  nil)

 (while (or(not en) (not (eq (cdr (assoc 0 lst)) "TEXT")))
 				      ;If an entity or text was not selected
   (setq en (entsel "\nPick a text height and style: \n "))
				      ;Ask user for text to match and select
				      ;object
   (if (not en)			      ;If no entity was selected
       (prompt "\nA TEXT entity was not selected: \n")
                                      ;Tell the user no entity was selected
       (progn			      ;Otherwise do the following commands
            (setq lst (entget (car en)))
                                      ;Get association list of entity
            (if (not (eq (cdr (assoc 0 lst)) "TEXT"))
				      ;Check that entity is TEXT
                (prompt "\nEntity is not TEXT .......!!! \n")
				      ;Tell user entity was not TEXT
            )                         ;End if not text
       )                              ;End progn
   )                                  ;End if not en
 )                                    ;End while not en or text

    (setq st (cdr(assoc 7 lst)))             ;Set st to style name of text
    (setq ht (cdr(assoc 40 lst)))            ;Set ht to height of text
    (setq wf (cdr(assoc 41 lst)))            ;Set wf to width of text
  (command "style" st "" ht wf "" "" "" "")  ;Set text to new values
 (prompt (strcat "\n\n<" st ">: is the current text style."))
                                             ;Inform user of new text style
 (prompt (strcat "\n<" (rtos ht 4 1 )">: is the current text height."))
                                             ;Inform user of new text height
(Princ)                                      ;Clean up command prompt area
)                                            ;End Definition of routine