174 lines
6.8 KiB
Common Lisp
174 lines
6.8 KiB
Common Lisp
;............................................................
|
|
;: DATE : 91-01-01 Kunde: :
|
|
;: Schuetz/Schmidt AutoCAD-Version 11 :
|
|
;: Version 1.0 ab Version 2.6 :
|
|
;: :
|
|
;: KREISTXT.LSP Bogenfoermiger Text :
|
|
;: Schreibt Text in bogenfoermiger Anordnung :
|
|
;:..........................................................:
|
|
;
|
|
;Deklaration:
|
|
; txts Kreis-Text Str
|
|
; txth Texth”he Real
|
|
; mp Zentrum des Textes List
|
|
; p1 Text-Startpunkt List
|
|
; endp Text-Endpunkt List
|
|
; wi1 Winkel Zentr. nach Startpt. Real
|
|
; wi2 Winkel Zentr. nach Endpt. Real
|
|
; krad Kreisradius Real
|
|
; tlen Textl„nge Int
|
|
; widreh Winkel zwischen den Zeichen Real
|
|
; lauf Laufvariable Int
|
|
; asatz Auswahlsatz (Text) Pickset
|
|
; tins Buchstaben aus dem Text Str
|
|
; wrech Winkel des Buchstabens Real
|
|
; pins Einf�gept des Buchstabens List
|
|
; angd Winkelrichtung (ANGDIR) Int
|
|
; angb Winkelbasis (ANGBASE) Real
|
|
; blip Konst.punkte (BLIPMODE) Int
|
|
; auni Winkeleinheit (AUNITS) Int
|
|
|
|
(DEFUN tdia() ;Textdialog
|
|
(SETQ txts (GETSTRING T "\nInput Text String: "))
|
|
;Gew�nschter Text an Variable TEXT0 binden
|
|
(INITGET (+ 1 2 4))
|
|
;keine Leereingabe, Nullwert oder negativer
|
|
;Wert f�r n„chste Getreal-Funktion setzen
|
|
(SETQ txth (GETREAL "Text Height: "))
|
|
;Texth”he abfragen und speichern
|
|
(INITGET 1)
|
|
(SETQ mp (GETPOINT "\nPick Center of Circle: "))
|
|
;Zentrum abfragen und speichern
|
|
(INITGET 1)
|
|
(SETQ p1 (GETPOINT mp "\nPick Text Startpoint: "))
|
|
;Startpunkt abfragen und speichern
|
|
(GRDRAW mp p1 -1)
|
|
;Startwinkel anzeigen
|
|
(INITGET 1)
|
|
(SETQ endp (GETPOINT mp "\nPick Text Endpoint: "))
|
|
;Endpunkt abfragen und speichern
|
|
)
|
|
|
|
(DEFUN trech(/ wi2) ;Textberechnung
|
|
(SETQ wi1 (ANGLE mp p1)
|
|
;Winkel Zentrum nach Startpt. speichern
|
|
wi2 (ANGLE mp endp)
|
|
;Winkel Zentrum nach Endpt. speichern
|
|
krad (DISTANCE mp p1)
|
|
;Abstand Zentrum nach Startpt. speichern
|
|
tlen (STRLEN txts)
|
|
;Textl„nge speichern
|
|
widreh (/ (IF (> wi1 wi2)
|
|
(- wi1 wi2)
|
|
(- (* PI 2)(- wi2 wi1))
|
|
)(- tlen 1)
|
|
)
|
|
;Winkel zwischen den Zeichen speichern
|
|
;Differenzwinkel / (Textl„nge - 1)
|
|
)
|
|
)
|
|
|
|
(DEFUN tmach(/ lauf tins wrech pins) ;Text schreiben
|
|
(SETQ lauf 0
|
|
;Z„hler auf Null setzen
|
|
asatz (SSADD)
|
|
;Auswahlsatz erzeugen
|
|
)
|
|
(WHILE (< lauf tlen)
|
|
;solange Z„hler kleiner als Textl„nge
|
|
(SETQ tins (SUBSTR txts (+ lauf 1) 1)
|
|
;extrahieren des einzuf�genden Zeichens
|
|
;tins = Das (Z„hler + 1) Zeichen von txts
|
|
wrech (- wi1 (* lauf widreh))
|
|
;absoluten Winkel des Zeichens speichern
|
|
pins (POLAR mp wrech krad)
|
|
;Einfuegept. des Zeichens speichern
|
|
)
|
|
(COMMAND "_TEXT" "_M" pins txth wrech tins)
|
|
;AutoCAD schreibt das aktuelle Zeichen
|
|
(SSADD (ENTLAST) asatz)
|
|
;aufnehmen in den Auswahlsatz
|
|
(SETQ lauf (1+ lauf))
|
|
;lauf um 1 erh”ht
|
|
)
|
|
;ende solange
|
|
)
|
|
|
|
(DEFUN tdreh(/ dif pz1 pz2) ;Text nachtr„glich drehen
|
|
(IF (= (STRCASE (SUBSTR (GETSTRING "\nRotatet the Circle Y/N <N>: ") 1 1)) "Y")
|
|
;wenn Kreis drehen mit "J" beantwortet wird
|
|
(PROGN
|
|
;beginne
|
|
(PRINC "\nRotation-Angle: ")
|
|
;Meldung Drehwinkel
|
|
(COMMAND "_ROTATE" asatz "" mp PAUSE)
|
|
;alles im Fenster drehen mit Zugmodus
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN *ERROR*(em) ;Fehlerbehandlungs-Funktion
|
|
(PROMPT "Abbruch ")
|
|
;Meldung 'Abbruch '
|
|
(PROMPT em)
|
|
;Meldung Art des Abbruches
|
|
(tend)
|
|
;zurr�cksetzen der Systemumgebung
|
|
)
|
|
|
|
(DEFUN tstart() ;Speichern der Systemumgebung und initialisieren
|
|
(SETQ angd (GETVAR "ANGDIR")
|
|
;Winkelrichtung speichern
|
|
angb (GETVAR "ANGBASE")
|
|
;Winkelbasis speichern
|
|
blip (GETVAR "BLIPMODE")
|
|
;Konstruktionspunktemodus speichern
|
|
auni (GETVAR "AUNITS")
|
|
;Winkeleinheit speichern
|
|
)
|
|
(SETVAR "ANGDIR" 0)
|
|
;Winkel positiv im Gegenuhrzeigersinn
|
|
(SETVAR "AUNITS" 3)
|
|
;Winkeleinheit auf Bogenmass setzen
|
|
(SETVAR "ANGBASE" (* (/ PI 2) 3))
|
|
;Winkelbasis auf -90 Grad setzen
|
|
(SETVAR "BLIPMODE" 0)
|
|
;Konstruktionspunktemodus aus
|
|
(SETVAR "CMDECHO" 0)
|
|
;Menur�ckgabe unterbinden
|
|
)
|
|
|
|
(DEFUN tend() ;Zur�cksetzen der Systemumgebung
|
|
(SETVAR "ANGDIR" angd)
|
|
;ANGDIR zur�cksetzen
|
|
(SETVAR "AUNITS" auni)
|
|
;AUNITS zur�cksetzen
|
|
(SETVAR "ANGBASE" angb)
|
|
;ANGBASE zur�cksetzen
|
|
(SETVAR "CMDECHO" 1)
|
|
;Menur�ckgabe wieder einschalten
|
|
(SETVAR "BLIPMODE" blip)
|
|
;Konstruktionspunktemodus zur�cksetzen
|
|
(REDRAW)
|
|
;Zeichnung neu aufbauen
|
|
(PRINC)
|
|
;unterdr�cken der R�ckgabe
|
|
)
|
|
|
|
(DEFUN C:KREISTXT(/ txts zxth mp p1 endp wi1 krad tlen widreh angd angb blip auni asatz) ;Kreistext
|
|
(tstart)
|
|
;initialisieren
|
|
(tdia)
|
|
;Text abfragen
|
|
(trech)
|
|
;Text rechnen
|
|
(tmach)
|
|
;Text erstellen
|
|
(PRINC "\n *** TEXT arranged ***")
|
|
;Meldung 'Text angeordnet' zur�ckgeben
|
|
(tdreh)
|
|
;Text drehen
|
|
(tend)
|
|
;zurr�cksetzen der Systemumgebung
|
|
)
|
|
|