m.stangl/Walz
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
Walz/MENU/ASCTEXT.LSP
T

408 lines
12 KiB
Common Lisp
Raw Permalink Blame History

;;; --------------------------------------------------------------------------;
;;; 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
;;; f�r Release 11 aktualisiert July 1990
;;; --------------------------------------------------------------------------;
;;; BESCHREIBUNG
;;;
;;; ASCTEXT.LSP wird verwendet, um ASCII-Textdateien in AutoCAD
;;; Zeichnungen einzuf�gen. Der Textblock kann im Links/Zentrum/
;;; Rechts oder Mitte-Modus eingef�gt 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 Verf�gung.
;;; 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 (f�r Vorgabewert)
;;; at_fnm : Letzte Datei (f�r 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 :Texteinf�gepunkt
;;; pt1 :erster Texteinf�gepunkt
;;; 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 Befehlsausf�hrung
; auftritt...
(if (/= st "Funktion abgebrochen")
(princ (strcat "\nFehler: " st))
)
(moder) ; Modi zur�cksetzen
(if (= (type rtfile) 'FILE)
(close rtfile)
)
(setq rtfile nil)
(setq *error* olderr) ; Fehlerbehandlung zur�cksetzen
(princ)
)
;;;
;;; Funktion f�r Texteinf�gung und Neuberechnung des Texteinf�gepunktes
;;;
(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 dr�cken, um zur Zeichnung zur�ckzukehren. ")
(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 einzuf�gender 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 f�r 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 zur�cksetzen
(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)

Reference in New Issue View Git Blame Copy Permalink