home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 2.ddi / ACAD2.PAK / ASCTEXT.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-08-10  |  8.9 KB  |  320 lines
  1. ; *******************************************************************
  2. ;                            ASCTEXT.LSP
  3.  
  4. ;       By Simon Jones  Autodesk Ltd, London  4 July 1986
  5.  
  6. ;   Use ASCTEXT.LSP to insert ASCII text files into AutoCAD drawings.
  7. ;   The blocks of text can be either Left, Center, Middle or Right
  8. ;   Justified.
  9.  
  10. ;   The file name must include an extension and may include a
  11. ;   directory prefix, as in /acad/sample.txt or \\acad\\sample.txt.
  12.  
  13. ;   Apart from height (unless fixed) & rotational angle,
  14. ;   "Text options" include:
  15. ;       Define distance between lines.
  16. ;       Define opening line for reading.
  17. ;       Define number of lines to read.
  18. ;       Global under/overscoring of lines.
  19. ;       Global upper/lower case change.
  20. ;    &  Column definitions.
  21.  
  22. ;   Modified for use with AutoCAD 2.6     23 April 1987
  23. ; *******************************************************************
  24.  
  25. ;--------:GLOBAL variables
  26.  
  27. ; a$$    :Last angle (for default value)
  28. ; f$$    :Last file  (for default value)
  29. ; rtfile :Read File
  30. ; ang    :Rotation angle
  31. ; c      :Total line count
  32. ; cd     :Column distance
  33. ; d      :Distance between lines
  34. ; eof    :End of file flag
  35. ; l1     :First line to read
  36. ; h      :Text height
  37. ; j      :Text justification
  38. ; lc     :Column line count
  39. ; n      :Number of lines to read
  40. ; nl     :Number of lines per column
  41. ; opt    :Options list
  42. ; pt     :Text insertion point
  43. ; pt1    :First text insertion point
  44. ; rf     :File to read
  45. ; s      :Text string
  46. ; ts     :Text style list
  47. ; ul     :Upper/lower case flag
  48.  
  49. (defun MODES (a)
  50.    (setq MLST '())
  51.    (repeat (length a)
  52.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  53.       (setq a (cdr a)))
  54. )
  55.  
  56. (defun MODER ()
  57.    (repeat (length MLST)
  58.       (setvar (caar MLST) (cadar MLST))
  59.       (setq MLST (cdr MLST))
  60.    )
  61. )
  62.  
  63.  
  64. (defun atxterr (st)                   ; If an error (such as CTRL-C) occurs
  65.                                       ; while this command is active...
  66.   (if (/= st "Function cancelled")
  67.       (princ (strcat "\nError: " st))
  68.   )
  69.   (moder)                             ; Restore modified modes
  70.   (if (= (type rtfile) 'FILE) (close rtfile))
  71.   (setq rtfile nil)
  72.   (setq *error* olderr)               ; Restore old *error* handler
  73.   (princ)
  74. )
  75.  
  76.  
  77.    ;Function for inserting text a recalculation of insertion
  78.    ;point.
  79.  
  80.    (defun 1LTXT ()
  81.       (if (member '1 opt) (setq s (strcat "%%u" s "%%u")))
  82.       (if (member '2 opt) (setq s (strcat "%%o" s "%%o")))
  83.       (if (member '4 opt) (setq s (strcase s)))
  84.       (if (member '8 opt) (setq s (strcase s T)))
  85.       (if (and (= lc (1+ nl)) (/= nl 0))
  86.           (progn
  87.            (setq lc 1)
  88.            (setq pt (polar pt1 ang cd))
  89.            (setq pt1 pt)
  90.           )
  91.       )
  92.       (cond ((and (= j "L") h)
  93.              (command "TEXT" pt h (rtd ang) s)
  94.             )
  95.             ((and (/= j "L") h)
  96.              (command "TEXT" j pt h (rtd ang) s)
  97.             )
  98.             ((and (= j "L") (null h))
  99.              (command "TEXT" pt (rtd ang) s)
  100.             )
  101.             ((and (/= j "L") (null h))
  102.              (command "TEXT" j pt (rtd ang) s)
  103.             )
  104.       )
  105.       (if (/= d "Auto")
  106.           (if (= (cdr (assoc 70 ts)) 4)
  107.               (setq pt (polar pt (+ (dtr 90) ang) d))
  108.               (setq pt (polar pt (+ (dtr 270) ang) d))
  109.           )
  110.       )
  111.       (setq c (1+ c))
  112.       (if (= c n)
  113.           (setq eof T)
  114.       )
  115.    )
  116.  
  117.    ;Degrees to radians conversion
  118.    (defun DTR (y)
  119.     (* pi (/ y 180.0))
  120.    )
  121.    ;Radians to degrees conversion
  122.    (defun RTD (Y)
  123.     (* 180.0 (/ y pi))
  124.    )
  125.  
  126. ;********************** MAIN PROGRAM ***************************
  127.  
  128.  
  129. (defun C:ASCTEXT (/ olderr ang c cd d eof rtfile rf h
  130.                     j l1 opt pt pt1 ts n nl lc s ul)
  131.  
  132.   ; a$$ holds default ANGLE
  133.   ; f$$ holds default fILE
  134.  
  135.   (setq olderr  *error*
  136.         *error* atxterr)
  137.   (modes '("BLIPMODE" "CMDECHO" "HIGHLIGHT"))
  138.  
  139.   (while (null rtfile)
  140.          ;Prompt for file to be inserted
  141.          (if (null f$$)
  142.              (progn
  143.               (initget 1)
  144.               (prompt "\nFile to read (including extension): ")
  145.              )
  146.              (progn
  147.               (prompt "\nFile to read (including extension)/<")
  148.               (princ (strcat f$$ ">: "))
  149.              )
  150.          )
  151.          (setq rf (getstring))
  152.          (if (and (= rf "") (/= nil f$$))
  153.              (setq rf f$$)
  154.          )
  155.          (setq rtfile (open rf "r"))
  156.          (if rtfile
  157.              (setq f$$ rf)
  158.              (prompt "\nFile not found. ")
  159.          )
  160.   )
  161.  
  162.   ;Prompt for start point or justification
  163.   (initget 1  "Center Middle Right")
  164.   (setq pt (getpoint
  165.              "\nStart point or Center/Middle/Right: "
  166.            )
  167.   )
  168.   (if (/= (type pt) 'LIST)
  169.       (setq j (substr pt 1 1))
  170.       (setq j "L")
  171.   )
  172.  
  173.  
  174.   ;Prompt for an insertion point
  175.   (if (/= (type pt) 'LIST)
  176.       (progn
  177.        (initget 1)
  178.        (setq pt (getpoint (strcat "\n" pt " point: ")))
  179.       )
  180.   )
  181.   (setq pt1 pt)  ; First insertion point
  182.  
  183.   ;Prompt for a text height
  184.   (setq ts (tblsearch "STYLE" (getvar "TEXTSTYLE"))
  185.         h nil
  186.   )
  187.   (if (= (cdr (assoc 40 ts)) 0.0)
  188.       (progn
  189.         (initget 6)
  190.         (setq h (getdist pt (strcat "\nHeight <"
  191.                                     (rtos (getvar "TEXTSIZE"))
  192.                                     ">: "
  193.                             )
  194.                 )
  195.         )
  196.         (if (null h) (setq h (getvar "TEXTSIZE")))
  197.       )
  198.   )
  199.  
  200.   ;Prompt for rotation angle of text
  201.   (if (null a$$)
  202.       (progn
  203.        (if (= (cdr (assoc 70 ts)) 4)  ; Vertical style text
  204.            (progn
  205.             (setq a$$ 270)
  206.             (prompt "\nRotation angle <270>: ")
  207.            )
  208.            (progn
  209.             (setq a$$ 0)
  210.             (prompt "\nRotation angle <0>: ")
  211.            )
  212.        )
  213.       )
  214.       (progn
  215.        (prompt "\nRotation angle <")
  216.        (princ (strcat (angtos a$$) ">: "))
  217.       )
  218.   )
  219.   (setq ang (getangle pt))
  220.   (if (null ang) (setq ang a$$))
  221.   (setq a$$ ang)
  222.  
  223.   (setq d "Auto" l1 1 n "All" opt nil lc 0 nl 0 c 0)
  224.  
  225.   (initget "Yes No")
  226.   (if (= "Yes"  (getkword "\nChange text options? <N>: "))
  227.      (progn
  228.  
  229.        ;Prompt for distance between lines.
  230.        (initget "Auto")
  231.        (setq d (getdist pt "\nDistance between lines/<Auto>: "))
  232.        (if (= d nil) (setq d "Auto"))
  233.  
  234.        ;Prompt for first line to read.
  235.        (initget (+ 2 4))
  236.        (setq l1 (getint "\nFirst line to read/<1>: "))
  237.        (if (null l1) (setq l1 1))
  238.  
  239.        ;Prompt for number of following lines.
  240.        (initget (+ 2 4) "All")
  241.        (setq n (getint "\nNumber of lines to read/<All>: "))
  242.        (if (= n "All") (setq n nil))
  243.  
  244.        (initget "Yes No")
  245.        (if (= "Yes" (getkword "\nUnderscore each line? <N>: "))
  246.            (setq opt (append opt '(1)))
  247.        )
  248.        (initget "Yes No")
  249.        (if (= "Yes" (getkword "\nOverscore each line? <N>: "))
  250.            (setq opt (append opt '(2)))
  251.        )
  252.  
  253.        ; Option for global redefinition of text case.
  254.        (initget "Upper Lower No")
  255.        (prompt "\nChange text case? ")
  256.        (setq ul (getkword "  Upper/Lower/<N>: "))
  257.        (cond ((= ul "Upper") (setq opt (append opt '(4))))
  258.              ((= ul "Lower") (setq opt (append opt '(8))))
  259.        )
  260.  
  261.        ; Option for setting up columns.
  262.        (initget "Yes No")
  263.        (if (= "Yes" (getkword "\nSet up columns? <N>: "))
  264.            (progn
  265.             (setq opt (append opt '(16)))
  266.             (initget (+ 1 2))
  267.             (setq cd (getdist pt "\nDistance between columns: "))
  268.             (initget (+ 1 2 4))
  269.             (setq nl (getint "\nNumber of lines per column: "))
  270.            )
  271.        )
  272.  
  273.      )
  274.   )
  275.   (setvar "BLIPMODE" 0)
  276.   (setvar "HIGHLIGHT" 0)
  277.   (setvar "CMDECHO" 0)
  278.  
  279.   (setq eof nil)
  280.   (setq s (repeat l1 (read-line rtfile)))
  281.  
  282.   (setq lc (1+ lc))
  283.   (1ltxt)
  284.   (while (null eof)
  285.     (if (= d "Auto")
  286.         (progn
  287.          (setq s (read-line rtfile))
  288.          (setq lc (1+ lc))
  289.          (if s
  290.            (progn
  291.             (if (= lc (1+ nl))
  292.                 (1ltxt)
  293.                 (progn
  294.                  (if (member '1 opt) (setq s (strcat "%%u" s "%%u")))
  295.                  (if (member '2 opt) (setq s (strcat "%%o" s "%%o")))
  296.                  (if (member '4 opt) (setq s (strcase s)))
  297.                  (if (member '8 opt) (setq s (strcase s T)))
  298.                  (command "TEXT" "" s)
  299.                  (setq c (1+ c))
  300.                  (if (= c n) (setq eof T))
  301.                 )
  302.             )
  303.            )
  304.            (setq eof T)
  305.          )
  306.         )
  307.         (progn
  308.          (setq s (read-line rtfile))
  309.          (setq lc (1+ lc))
  310.          (if s (1ltxt) (setq eof T))
  311.         )
  312.     )
  313.   )
  314.   (close rtfile)                    
  315.   (setq rtfile nil)
  316.   (moder)                             ; Restore modified modes
  317.   (setq *error* olderr)               ; Restore old *error* handler
  318.   (princ)
  319. )
  320.