home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / dbase / tab123.zip / TAB123.LSP < prev    next >
Lisp/Scheme  |  1992-09-09  |  7KB  |  243 lines
  1. ;;; *========================[ Tab123.LSP ]==============================*
  2. ;;;
  3. ;;; Tab123 creates a table in AutoCAD from a Lotus 123 file.
  4. ;;; Read_WKS.EXE must be on the DOS path, and SHELL must provide
  5. ;;; at least 150K of free memory for Read_WKS.EXE to execute.
  6. ;;;
  7. ;;; by Jerry Workman, CopyRight (c) Mountain Software, 1991
  8. ;;;
  9. ;;; *====================================================================*
  10.  
  11. ;;; Initalize Globals
  12.  
  13. (If (Not rsf)
  14.   (SetQ rsf 2.0
  15.         cof 1.0))
  16.  
  17. ;;; Our error routine
  18.  
  19. (defun AtErr(s)
  20.   (If (/= s "Function cancelled")
  21.       (Princ (StrCat "\nError: " s))
  22.   )
  23.   (moder)                             ; Restore modified modes
  24.   (If (= (Type fp) 'FILE) (SetQ fp (Close rtfile)))
  25.   (setq *error* olderr)               ; Restore old *error* handler
  26.   (princ)
  27. )
  28.  
  29. ;;; swiped this from ADESK
  30.  
  31. (defun Modes (a)
  32.    (setq MLST '())
  33.    (repeat (length a)
  34.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  35.       (setq a (cdr a)))
  36. )
  37.  
  38. ;;; and this
  39.  
  40. (defun Moder ()
  41.    (repeat (length MLST)
  42.       (setvar (caar MLST) (cadar MLST))
  43.       (setq MLST (cdr MLST))
  44.    )
  45. )
  46.  
  47. ;;; Draw a grid around the table
  48.  
  49. (Defun DrawGrid ( / gx gy r c)
  50.   (SetQ gx sx chars 0 r 0 c 0)
  51.   ; Calculate horizontal line length
  52.   (ForEach c colwid (SetQ chars (+ chars c)))
  53.   ; Draw Horizontal Lines
  54.   (SetQ x2 (+ sx (* cols (* 2 CharOS)) (* chars CharSiz)))
  55.   (Command ".LINE" (List sx sy) (List x2 sy) "")
  56.   (Command ".ARRAY" "L" "" "R" (1+ rows) 1 (* -1 rc))
  57.   ; Draw Vertical lines
  58.   (SetQ y2 (- sy (* rows rc)))
  59.   (While (<= c cols) (Progn
  60.     (If(> c 0)
  61.       (SetQ cw  (Nth (1- c) colwid)
  62.             gx  (+ gx (* 2 CharOS) (* cw CharSiz)))
  63.     )
  64.     (SetQ pt1 (List gx sy)
  65.           pt2 (List gx y2)
  66.     )
  67.     (Command ".line" pt1 pt2 "")
  68.     (SetQ c (1+ c))
  69.   ))
  70. )
  71.  
  72. ;;; Draw the text entities from ACAD.123
  73.  
  74. (Defun c:DrawTab ()
  75.   (setq olderr  *error*
  76.         *error* AtErr)
  77.   (Modes '("BLIPMODE" "CMDECHO"))
  78.   (SetVar "BLIPMODE" 0)
  79.   (SetVar "CMDECHO" 0)
  80.   (If (Null (SetQ fp (open "ACAD.123" "r")))
  81.     (Princ "\nError: Can't open file \"ACAD.123\"")
  82.   ;else
  83.     (Progn
  84.       (SetQ line (Read-Line fp))          ; size of table
  85.       (If line (Progn
  86.         (SetQ size (read line))
  87.         (graphscr)
  88.         (prompt "\nTable file \"ACAD.123\" opened...")
  89.         (SetQ pt (getpoint "\nTable Insertion point: "))
  90.  
  91.         ;*----Prompt for a text height
  92.         (SetQ ts (tblsearch "STYLE" (getvar "TEXTSTYLE"))
  93.               h nil
  94.         )
  95.         (If (= (Cdr (Assoc 40 ts)) 0.0)
  96.           (Progn
  97.             (InitGet 6)
  98.             (SetQ h (GetDist pt (strcat "\nText Height <"
  99.                                         (rtos (getvar "TEXTSIZE"))
  100.                                         ">: "
  101.                                 )
  102.                     )
  103.             )
  104.             (If (Null h)
  105.               (SetQ h (getvar "TEXTSIZE")))
  106.             (SetQ hmode nil)
  107.           ) ;else
  108.           (SetQ h (Cdr (Assoc 40 ts))
  109.                 hmode 1)
  110.         )
  111.         (SetQ sx  (Car pt)
  112.               sy  (Cadr pt)
  113.               rc  (* rsf h)                       ; row centers
  114.               wf  (Cdr (Assoc 41 ts))             ; character width factor
  115.               CharSiz (* wf h)                    ; character width
  116.               CharOS (* CharSiz cof)              ; character offset
  117.               x   (+ sx CharOS)
  118.               y   (- sy (- rc (/ (* (1- rsf) h) 2)))
  119.               cols (Car size)
  120.               rows (Cadr size)
  121.               colwid (read (Read-Line fp))        ; column width List
  122.               row 1
  123.         )
  124.         (InitGet "Yes No")
  125.         (If (/= "No" (getkword "\nCreate table grid?<Yes>: "))
  126.           (DrawGrid))
  127.         (While (<= row rows) (Progn
  128.           (SetQ line (Read-Line fp))
  129.           (SetQ col 0
  130.                 tx x)
  131.           (If (> row 1)
  132.             (SetQ y (- y rc)))
  133.           (If line
  134.             (SetQ cells (read line))
  135.           ;else
  136.             (SetQ cells nil)
  137.           )
  138.           (ForEach cell cells
  139.             (If(> col 0)
  140.               (SetQ lcw (Nth (1- col) colwid)
  141.                     tx  (+ tx (* 2 CharOS) (* lcw CharSiz)))
  142.             )
  143.             (SetQ Just (Car cell)
  144.                   cw   (Nth col colwid))
  145.             (Cond ((= Just 1)
  146.                    (SetQ pt (List tx y))
  147.                   )
  148.                   ((= Just 2)
  149.                    (SetQ pt (List (+ tx (/ (* cw CharSiz) 2)) y)
  150.                          j "c")
  151.                   )
  152.                   ((= Just 3)
  153.                    (SetQ pt (List (- (+ tx (* cw CharSiz))(* 0.7 CharSiz)) y)
  154.                          j "r")
  155.                   )
  156.                   ((= Just 4)
  157.                    (SetQ pt (List (+ tx (* cw CharSiz)) y)
  158.                          j "r")
  159.                   )
  160.             )
  161.             (Command ".text")
  162.             (If (> Just 1)
  163.               (Command j))
  164.             (Command pt)
  165.             (If (Not hmode)
  166.               (Command h))
  167.             (Command 0 (Cadr cell))
  168.             (SetQ col (1+ col))
  169.           )
  170.           (SetQ row (1+ row))
  171.         ))
  172.         (Princ "\nTab123 finished...")
  173.       )
  174.         (Princ"\nNo Table Loaded...")
  175.       )
  176.     )
  177.   )
  178.   (Moder)
  179.   (setq *error* olderr)               ; Restore old *error* handler
  180.   (Princ)
  181. )
  182.  
  183. ;;; Execute Read_WKS
  184.  
  185. (Defun c:LoadTab ()
  186.   (If (SetQ fp (open "ACAD.123" "w"))
  187.     (close fp))                         ;just as good as erasing it
  188.   (Command "shell" "READ_WKS.EXE /A /I")
  189.   (Princ)
  190. )
  191.  
  192. ;;; Get a floating point value
  193.  
  194. (Defun GtReal( txt dflt / val )
  195.   (SetQ val (GetReal (strcat txt "<" (rtos dflt 2 2) ">:")))
  196.   (If val
  197.     val
  198.     dflt)
  199. )
  200.  
  201. ;;; Prompt / report parameters
  202.  
  203. (Defun GetParms ( / cmd )
  204.   (Princ(strcat "\nParameters: Row Scale Factor[" (rtos rsf 2 2)
  205.                 "] Character Offset Factor[" (rtos cof 2 2) "]"
  206.   ))
  207.   (InitGet "RowScaleFactor CharOffsetFactor Exit")
  208.   (SetQ cmd (getkword "\nRowScaleFactor/CharOffsetFactor/Exit/<Exit>:"))
  209.   (Cond ((= cmd "RowScaleFactor")
  210.         (SetQ rsf (GtReal "\nEnter Row Scale Factor" rsf)))
  211.         ((= cmd "CharOffsetFactor")
  212.         (SetQ cof (GtReal "\nEnter Character Offset Factor" cof)))
  213.   )
  214.   (Princ)
  215. )
  216.  
  217. ;;; The Main program
  218. (Defun c:Tab123 ( / cmd )
  219.   (InitGet "Load Draw All Parms Exit")
  220.   (SetQ cmd (getkword "\nLoad/Draw/All/Parms/Exit/<All>:"))
  221.   (If (Not cmd)
  222.     (SetQ cmd "All"))
  223.   (Cond ((= cmd "All")
  224.           (c:LoadTab)
  225.           (c:DrawTab)
  226.         )
  227.         ((= cmd "Load")
  228.           (c:LoadTab)
  229.         )
  230.         ((= cmd "Draw")
  231.           (c:DrawTab)
  232.         )
  233.         ((= cmd "Parms")
  234.           (GetParms)
  235.         )
  236.   )
  237.   (Princ)
  238. )
  239.  
  240. (Princ "\nTab123 loaded\nEnter TAB123 to execute.")
  241. (Princ)
  242.  
  243.