;;; --------------------------------------------------------------------------;
;;; ASCTEXT.LSP
;;;   Copyright (C) 1990 by Autodesk, Inc.
;;;
;;;  DIESE SOFTWARE WIRD WIRD OHNE JEGLICHE AUSDRUECKLICHE ODER STILL-
;;;  SCHWEIGENDE GEWAEHRLEISTUNG GELIEFERT.
;;;  ALLE GEWAEHRLEISTUNGEN DER EIGNUNG FUER BESONDERE VERWENDUNG UND
;;;  LAUFFAEHIGKEIT WERDEN HIERMIT ABGELEHNT.
;;;
;;;   By Simon Jones  Autodesk Ltd, London  4 July 1986
;;;
;;;   Modified for use with AutoCAD 2.6           23 April 1987
;;;   fr Release 11 aktualisiert                    July 1990
;;; --------------------------------------------------------------------------;
;;; BESCHREIBUNG
;;;
;;;   ASCTEXT.LSP wird verwendet, um ASCII-Textdateien in AutoCAD
;;;   Zeichnungen einzufgen. Der Textblock kann im Links/Zentrum/
;;;   Rechts oder Mitte-Modus eingefgt werden.

;;;   Der Dateiname muss mit Erweiterung angegeben werden. Die
;;;   Eingabe Dateiprefix ist gestattet.z. B.: /acad/sample.txt oder
;;;   \\acad\sample.txt

;;;   Abgesehen von der H”he (ausser wenn fixiert) und dem Drehwinkel
;;;   stehen folgende Optionen zur Verfgung.
;;;       Abstand zwischen den Zeilen.
;;;       Erste zu lesende Zeile.
;;;       Anzahl zu lesender Zeilen.
;;;       Allgemeines ber- oder unterstreichen.
;;;       Allgemeine Gross/Kleinschreibung.
;;;    &  Kolonnendefinition.
;;;
;;; --------------------------------------------------------------------------;
;;;
;;; -------: Globale Variablen
;;; at_ang : Letzter Winkel (fr Vorgabewert)
;;; at_fnm : Letzte Datei (fr Vorgabewert)
;;; rtfile : Datei zu lesen
;;; ang    :Drehwinkel
;;; c      :Gesamte Zeilenanzahl
;;; cd     :Kolonnenabstand
;;; d      :Zeilenabstand
;;; eof    :Zeilenendeflags
;;; l1     :Erste zu lesende Zeile
;;; h      :Texth”he
;;; j      :Textausrichtung
;;; lc     :Nummer der Kolonnenzeile
;;; n      :Anzahl zu lesender Zeilen
;;; nl     :Anzahl der Zeilen pro Kolonne
;;; opt    :Optionsliste
;;; pt     :Texteinfgepunkt
;;; pt1    :erster Texteinfgepunkt
;;; rf     :zu lesende Datei
;;; s      :Textstring
;;; ts     :Textstilliste
;;; ul     :Gross-/Kleinschreibung
;;;
;;;---------------------------------------------------------------------------;

;;;
;;; Systemvariablen Sichern
;;;
(defun MODES (a)
  (setq MLST '
        ())
  (repeat (length a)
    (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
    (setq a (cdr a))
  )
)
;;;
;;; gesicherte Systemvariablen Wiederherstellen
;;;
(defun MODER ()
  (repeat (length MLST)
    (setvar (caar MLST) (cadar MLST))
    (setq MLST (cdr MLST))
  )
)
;;;
;;; ASCII Text Fehlerbehandlung
;;;
(defun at_err (st)                    ; Wenn ein Fehler (z.B. CTRL-C)
                                      ; w„hrend der Befehlsausfhrung
                                      ; auftritt...
  (if (/= st "Funktion abgebrochen")
    (princ (strcat "\nFehler: " st))
  )
  (moder)                             ; Modi zurcksetzen
  (if (= (type rtfile) 'FILE)
    (close rtfile)
  )
  (setq rtfile nil)
  (setq *error* olderr)               ; Fehlerbehandlung zurcksetzen
  (princ)
)
;;;
;;; Funktion fr Texteinfgung und Neuberechnung des Texteinfgepunktes
;;;
(defun 1LTXT ()
  (if (member '1 opt)
    (setq s (strcat "%%u" s "%%u"))
  )
  (if (member '2 opt)
    (setq s (strcat "%%o" s "%%o"))
  )
  (if (member '4 opt)
    (setq s (strcase s))
  )
  (if (member '8 opt)
    (setq s (strcase s T))
  )
  (if (and (= lc (1+ nl)) (/= nl 0))
    (progn
      (setq lc 1)
      (setq pt (polar pt1 ang cd))
      (setq pt1 pt)
    )
  )
  ;(grread)
  (cond
    ((and (= j "Ausrichten") h) (command "TEXT" j pt pt2 s))
    ((and (= j "Ausrichten") (null h)) (command "TEXT" j pt pt2 s))
    ((and (= j "Einpassen") h) (command "TEXT" j pt pt2 h (rtd ang) s))
    ((and (= j "Einpassen") (null h)) (command "TEXT" j pt pt2 (rtd ang) s))
    ((and (= j "L") h) (command "TEXT" pt h (rtd ang) s))
    ((and (= j "L") (null h)) (command "TEXT" pt (rtd ang) s))
    ((and (/= j "L") h) (command "TEXT" j pt h (rtd ang) s))
    ((and (/= j "L") (null h)) (command "TEXT" j pt (rtd ang) s))
  )
  (if (/= d "Auto")
    (if (= (cdr (assoc 70 ts)) 4)
      (setq pt (polar pt (+ (dtr 90) ang) d))
      (setq pt (polar pt (+ (dtr 270) ang) d))
    )
  )
  (setq c (1+ c))
  (if (= c n)
    (setq eof T)
  )
)
;;;
;;; Grad in Radiant umrechnen
;;;
(defun DTR (y)
  (* pi (/ y 180.0))
)
;;;
;;; Radians to degrees conversion
;;;
(defun RTD (Y)
  (* 180.0 (/ y pi))
)
;;;
;;; Liste der Optionen
;;;
(defun justpn ()
  (if (getvar "DIMCLRD") (textpage))
  (princ "\nAusrichtungsoptionen: ")
  (princ "\n\t OLinks   OZentriert   ORechts ")
  (princ "\n\t MLinks   MZentriert   MRechts ")
  (princ "\n\t ULinks   UZentriert   URechts ")
  (princ "\n\t  Links    Zentriert    Rechts ")
  (princ "\n\tAusrichten   Mitte   Einpassen ")
  (if (not (getvar "DIMCLRD")) (textscr))
  (princ "\n\nBeliebige Taste drcken, um zur Zeichnung zurckzukehren. ")
  (grread)
  (princ "\r                                                    ")
  (graphscr)
)
;;;
;;; -------------------------- HAUPT PROGRAMM ----------------------------------
;;;
(defun asctxt (/ olderr ang c cd d eof rtfile rf rfa h j l1 opt pt pt1 ts n nl
                    lc s ul)          ; at_ang = Vorgabewinkel
                                      ; at_fnm = Vorgabedatei
  (setq olderr *error*
        *error* at_err)
  (modes '("BLIPMODE" "CMDECHO" "HIGHLIGHT")
  )
  (while (null rtfile)                ; Anfrage nach einzufgender Datei
    (if (null at_fnm)
      (progn
        (initget 1)
        (princ "\nZu lesende Datei (mit Dateierweiterung): ")
      )
      (progn
        (princ "\nZu lesende Datei (mit Dateierweiterung)/<")
        (princ (strcat at_fnm ">: "))
      )
    )
    (setq rf (getstring))
    (if (and (= rf "") (/= nil at_fnm))
      (setq rf at_fnm)
    )
    (setq rfa (findfile rf))
    (if rfa
      (progn
        (setq at_fnm rfa)
        (if (null (setq rtfile (open rfa "r")))
          (princ (strcat
            "\n\tDatei " at_fnm " gefunden, kann sie aber nicht zum Lesen ”ffnen. "))
        )
      )
      (if (/= (substr rf (- (strlen rf) 3) 1) ".")
        (princ "\nDatei nicht gefunden. Eventuell haben Sie die Erweiterung vergessen.")
        (princ "\nDatei nicht gefunden. ")
      )
    )
  )
  (setq cont T)
  ;; Anfrage nach dem Startpunkt oder Ausrichtung
  (while cont
    (if (getvar "DIMCLRD")
      (initget 1 (strcat "OLinks OZentriert ORechts "
                         "MLinks MZentriert MRechts "
                         "ULinks UZentriert URechts "
                         "Ausrichten Zentriert Einpassen Links Mitte Rechts ?"))
      (initget 1 "Ausrichten Zentriert Einpassen Links Mitte Rechts ?")
    )
    (setq pt (getpoint
             "\nStartpunkt oder Zentriert/Mitte/Rechts/?: "))
    (if (/= (type pt) 'LIST)
      (if (= pt "?")
        (progn
          (justpn)
          (setq cont T)
        )
        (progn
          (setq cont nil)
          (setq j (substr pt 1 2))
          ;;(setq j pt)
          (if (= j "Zentriert") (setq j "MZentriert"))
          (initget 1)
          (setq pt (getpoint (strcat "\n" pt " Punkt: ")))
          (if (or (= j "Ausrichten") (= j "Einpassen"))
            (progn
              (initget 1)
              (setq pt2 (getpoint pt (strcat "\nAnderer Punkt: ")))
              (setq at_ang (* (/ 180 pi) (angle pt pt2)))
            )
          )
        )
      )
      (setq j    "L"
            cont nil
      )
    )
  )
  (setq pt1 pt)

  ;; Frage nach der Texth”he

  (setq ts (tblsearch "STYLE" (getvar "TEXTSTYLE"))
        h nil)
  (if (and (/= j "Ausrichten") (= (cdr (assoc 40 ts)) 0.0))
    (progn
      (initget 6)
      (setq h (getdist pt (strcat "\nH”he <"
                                  (rtos (getvar "TEXTSIZE")) ">: ")))
      (if (null h)
        (setq h (getvar "TEXTSIZE"))
      )
    )
  )                                   ;Frage nach dem Drehwinkel des Textes
  (if (null at_ang)
    (progn
      (if (= (cdr (assoc 70 ts)) 4)   ; vertikaler Textstil
        (progn
          (setq at_ang 270)
          (princ "\nDrehwinkel <270>: ")
        )
        (progn
          (setq at_ang 0)
          (princ "\nDrehwinkel <0>: ")
        )
      )
    )
    (if (and (/= j "Ausrichten") (/= j "Einpassen"))
      (progn
        (princ "\nDrehwinkel <")
        (princ (strcat (angtos at_ang) ">: "))
      )
    )
  )
  (setq ang (getangle pt))
  (if (null ang)
    (setq ang at_ang)
  )
  (setq at_ang ang)
  (setq d "Auto"
        l1 1
        n "Alle"
        opt nil
        lc 0
        nl 0
        c 0)
  (initget "Ja Nein")
  (if (= "Ja" (getkword "\nTextoptionen „ndern <N>: "))
    (progn                            ; Anfrage Zeilenabstand
      (initget "Auto")
      (setq d (getdist pt "\nAbstand zwischen den Zeilen/<Auto>: "))
      (if (= d nil)
        (setq d "Auto")
      )                               ; Frage nach der ersten zu lesenden Zeile.
      (initget (+ 2 4))
      (setq l1 (getint "\nErste Zeile zum Lesen/<1>: "))
      (if (null l1)
        (setq l1 1)
      )                               ; Frage nach der Zahl der folgenden Zeilen
      (initget (+ 2 4) "Alle")
      (setq n (getint "\nAnzahl der zu lesenden Zeilen/<Alle>: "))
      (if (= n "Alle")
        (setq n nil)
      )
      (initget "Ja Nein")
      (if (= "Ja" (getkword "\nJede Zeile unterstreichen? <N>: "))
        (setq opt (append opt '(1)))
      )
      (initget "Ja Nein")
      (if (= "Ja" (getkword "\nJede Zeile berstreichen? <N>: "))
        (setq opt (append opt '(2)))
      )                               ; Option fr algemeine Neudefinition
                                      ; der Textdarstellung.
      (initget "Gross Klein Nein")
      (princ "\nGross-/Kleinschreibung „ndern? ")
      (setq ul (getkword " Gross/Klein/<N>: "))
      (cond ((= ul "Gross") (setq opt (append opt '(4))))
        ((= ul "Klein") (setq opt (append opt '(8))))
      )                               ; Option, um Spalten zu setzen.
      (initget "Ja Nein")
      (if (= "Ja" (getkword "\nSpalten setzen? <N>: "))
        (progn
          (setq opt (append opt '(16)))
          (initget (+ 1 2))
          (setq cd (getdist pt "\nAbstand zwischen den Spalten: "))
          (initget (+ 1 2 4))
          (setq nl (getint "\nZeilenanzahl pro Spalte: "))
        )
      )
    )
  )
  (setvar "BLIPMODE" 0)
  (setvar "HIGHLIGHT" 0)
  (setvar "CMDECHO" 0)
  (setq eof nil)
  (setq s (repeat l1
            (read-line rtfile)
          ))
  (setq lc (1+ lc))
  (1ltxt)
  (while (null eof)
    (if (= d "Auto")
      (progn
        (setq s (read-line rtfile))
        (setq lc (1+ lc))
        (if s
          (progn
            (if (= lc (1+ nl))
              (1ltxt)
              (progn
                (if (member '1 opt)
                  (setq s (strcat "%%u" s "%%u"))
                )
                (if (member '2 opt)
                  (setq s (strcat "%%o" s "%%o"))
                )
                (if (member '4  opt)
                  (setq s (strcase s))
                )
                (if (member '8 opt)
                  (setq s (strcase s T))
                )
                (command "TEXT" "" s)
                (setq c (1+ c))
                (if (= c n)
                  (setq eof T)
                )
              )
            )
          )
          (setq eof T)
        )
      )
      (progn
        (setq s (read-line rtfile))
        (setq lc (1+ lc))
        (if s
          (1ltxt)
          (setq eof T)
        )
      )
    )
  )
  (close rtfile)
  (setq rtfile nil)
  (moder)                             ; Systemvariablen zurcksetzen
  (setq *error* olderr)               ; Fehlerroutine wiederherstellen
  (princ)
)

(defun c:at () (vmon) (asctxt))
(defun c:asctext () (vmon) (asctxt))
(princ "\n\tc:AscTxt geladen. Befehlsaufruf mit AT oder ASCTEXT.")
(princ)

