home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_RTXT.LSP < prev    next >
Lisp/Scheme  |  1996-09-30  |  3KB  |  92 lines
  1. ;;; FLX_RTXT.LSP
  2. ;;; =========================================================
  3. ;;; Provided for FelixCAD
  4. ;;; =========================================================
  5.  
  6. (defun FLX_RTEXT( / TEDIT_INIT prt_list el1 el2 ep1 p1
  7.                     s1 fl e1 t_widthfac t_height t_font 
  8.                     t_value t_angle tmp_cmdecho)
  9.    
  10.   ;;; Error Handler
  11.  
  12.   (FLX_FUNC_INIT)
  13.  
  14.   ;;; Prompt List
  15.  
  16.   (setq prt_list (list
  17.      "Select reference text: "
  18.      "Insertion point: "
  19.      "No text selected!"
  20.      "Reference Text"
  21.      "No entity in drawing!"
  22.      "Alert"
  23.    ))
  24.    (if FLX_XLANGUAGE (FLX_XLANGUAGE "_rtxt" nil))   
  25.  
  26.    ;;; Dialog Initialization Function
  27.  
  28.    (defun TEDIT_INIT( / n)
  29.       (if FLX$WIN95 (foreach n 
  30.         '("IDCANCEL" "IDOK" "IDHELP" "Edit1" "Font" "Height" "WidthFactor" 
  31.           "Angle" "Static1" "Static2" "Static3" "Static4")
  32.            (Dlg_TileSetFont n 2)
  33.       ))
  34.       (Dlg_TileSet "Font" t_font)
  35.       (Dlg_TileSet "Height" t_height)
  36.       (Dlg_TileSet "WidthFactor" t_widthfac)
  37.       (Dlg_TileSet "Angle" t_angle)
  38.       (Dlg_TileSet "Edit1" t_value)
  39.       (Dlg_TileMode "Edit1" 3) ;;; overwrite mode !
  40.       (Dlg_TileAction "Edit1" "(setq s1 (Dlg_TileGet \"Edit1\"))(Dlg_DialogDone)")
  41.       (Dlg_TileAction "IDOK" "(setq s1 (Dlg_TileGet \"Edit1\"))(Dlg_DialogDone)")
  42.       (Dlg_TileAction "IDCANCEL" "(setq s1 nil)(Dlg_DialogDone)")
  43.   )
  44.   (if (entlast)
  45.     (progn
  46.       (while (not (setq ep1 (entsel (nth 0 prt_list)))))
  47.       ;;;@Select reference text: 
  48.       (setq f1 nil e1 (car ep1) el1 (entget e1))
  49.       (if (= (cdr (assoc 0 el1)) "TEXT")
  50.         (progn
  51.           (setq
  52.             t_height   (rtos (cdr (assoc 40 el1)) -1 -1)
  53.             t_angle    (angtos (cdr (assoc 50 el1)) -1 -1)
  54.             t_widthfac (rtos (cdr (assoc 41 el1)) 2 2)
  55.             t_font     (cdr (assoc 7 el1))
  56.             t_value    (cdr (assoc 1 el1))
  57.           ) 
  58.           (if (FLX_DLGDSP "flx_dlg" "RTEXT" "(princ)" "(TEDIT_INIT)") 
  59.               (princ)
  60.               (exit)
  61.           )
  62.           (if s1 (progn
  63.              (setq f1 T)
  64.              (setq el2 (entmake (subst (cons 1 s1) (assoc 1 el1) el1)))
  65.              (setq p1 (cdr (assoc 10 el2)))
  66.              (setq tmp_cmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0)
  67.              (princ (nth 1 prt_list))  ;;;@Insertion point: 
  68.              (command ".MOVE" (entlast) "" p1)
  69.              (redraw e1 1)
  70.              (setvar "CMDECHO" tmp_cmdecho)
  71.           ))
  72.         )
  73.         (alert
  74.           (nth 2 prt_list)  ;;;@No text selected !
  75.           (nth 3 prt_list)  ;;;@Reference Text
  76.           "EXCLAMATION"
  77.         )
  78.       ) 
  79.     )
  80.     (alert
  81.          (nth 4 prt_list)  ;;;@No entity in drawing !
  82.          (nth 5 prt_list)  ;;;@Alert
  83.          "EXCLAMATION"
  84.     ) 
  85.   )  
  86.   (FLX_FUNC_EXIT) (setq *error* nil)
  87.   (princ)
  88. )
  89.  
  90. (princ)
  91.  
  92.