home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / QTEXT.LSP < prev    next >
Lisp/Scheme  |  1996-09-23  |  3KB  |  66 lines
  1. ;;; QTEXT.LSP
  2. ;;; ======================================================================
  3. ;;; Text Utilility QTEXT. Quick text by selecting reference text.
  4. ;;; Provided by Felix Computer Aided Technologies GmbH 1996 as Lisp Sample
  5. ;;; ======================================================================
  6.  
  7.  (defun C:QTEXT( / e1 f1 el1 el2 ep1 p1 s1 t_height t_value t_angle
  8.                    tmp_cmdecho)
  9.  
  10.    (defun text_error(s1)
  11.      (setvar "CMDECHO" tmp_cmdecho)
  12.      (if (= s1 "User break")
  13.          (if f1 (progn (entdel (entlast))(redraw e1 1)) )
  14.          (princ (strcat "\n*** " s1 " ***"))
  15.      )
  16.      (setq *error* nil f1 nil e1 nil)
  17.      (princ)
  18.    )
  19.    (setq *error* text_error)
  20.    (if (entlast)
  21.      (progn
  22.        (while (not (setq ep1 (entsel "Select reference text: "))))
  23.        (setq f1 nil e1 (car ep1) el1 (entget e1))
  24.        (if (= (cdr (assoc 0 el1)) "TEXT")
  25.             (progn
  26.                 (setq 
  27.                     t_height (rtos (cdr (assoc 40 el1)) 2 -1)
  28.                     t_angle (angtos (cdr (assoc 50 el1)) 0 -1)
  29.                     t_value (cdr (assoc 1 el1))
  30.                  )
  31.                 (setq s1 (getstring 0 (strcat "New text <" t_value ">: ")))
  32.                 (if (= s1 "") (setq s1 t_value))
  33.                 (if s1 (progn 
  34.                     (setq f1 T el2 (entmake (subst (cons 1 s1) (assoc 1 el1) el1)))
  35.                     (setq p1 (cdr (assoc 10 el2)))
  36.                     (setq tmp_cmdecho (getvar "CMDECHO"))
  37.                     (setvar "CMDECHO" 0)
  38.                     (princ "Text insertion point: ")
  39.                     (command ".MOVE" (entlast) "" p1)
  40.                     (redraw e1 1)
  41.                     (setq p1 (getvar "LASTPOINT"))
  42.                     (princ (strcat "\nCurrent text height: " t_height))
  43.                     (princ "\nScale factor <1.00>: ")
  44.                     (command ".SCALE" (entlast) "" p1 "_R" t_height)
  45.                     (princ (strcat "\nCurrent text insertion angle: " t_angle))
  46.                     (princ "\nText angle: ")
  47.                     (command ".ROTATE" (entlast) "" p1 "_R" t_angle)
  48.                     (setvar "CMDECHO" tmp_cmdecho)
  49.                 ))
  50.              )
  51.              (alert
  52.                   "No text selected!"
  53.                   "Alert"
  54.                   "EXCLAMATION"
  55.             )
  56.          ) 
  57.     )
  58.     (princ "No entity in drawing!")
  59.   )
  60.   (setq *error* nil)
  61.   (princ)
  62. )
  63. ;;; =================================================================
  64. (princ)
  65.  
  66.