Files

1842 lines
58 KiB
Common Lisp

;;;---------------------------------------------------------------------------;
;;;
;;; PText.lsp
;;; Copyright (C) 1990 by Autodesk, Inc.
;;;
;;; Hiermit gestatten wir, diese Software einschlieálich Dokumentation ohne
;;; Einschr„nkung und gebhrenfrei zu benutzen, zu kopieren, zu modifizieren
;;; und weiter zu vertreiben.
;;;
;;; DIESE SOFTWARE WIRD AUSGELIEFERT "WIE VORHANDEN" - OHNE EXPLIZITE ODER
;;; IMPLIZITE GEWŽHRLEISTUNG. JEDWEDE šBERNAHME VON GEWŽHRLEISTUNGEN FšR
;;; EINEN BESTIMMTEN ZWECK ODER EIGNUNG FšR DEN HANDELSVERKEHR WIRD HIERMIT
;;; ABGELEHNT.
;;;
;;; von Jan S. Yoder
;;; Herzlichen Dank an Kieran McKeogh fr seine Hinweise bei der Verwendung
;;; von Steuerzeichen.
;;; 15. Februar 1990
;;;
;;;---------------------------------------------------------------------------;
;;; šBERSICHT
;;; PTEXT -- Textverarbeitungsmodul.
;;;
;;; Text kann auf vier verschiedene Arten direkt im Textbereich eingegeben
;;; werden: Ausrichtung an den rechten Rand, zentriert, an den linken Rand
;;; oder Einpassen zwischen zwei Markierungen. Solange keine eigene Funktion
;;; die GrӇe eines Textausdrucks mittels eines vorgegebenen Fonts, Anzahl
;;; oder Gr”áe der Zeichen steuert, werden W”rter lediglich nach einigen
;;; Grundvoraussetzungen umgebrochen.
;;;
;;; Die tats„chliche Anzahl an Zeichen im Puffer - auch ber das
;;; vordefinierte Maximum hinaus - kann vom Benutzer eingestellt werden.
;;;
;;; Die Routine liest die Tastatureingaben mittels (grread) und generiert
;;; auf der Grundlage dieser Eingaben den aktuellen Text als Objekt. Die
;;; Verarbeitungsgeschwindigkeit der Routine kann durch folgende Faktoren
;;; unakzeptabel absinken:
;;;
;;; Die Routine in mehreren Ansichtsfenstern ablaufen lassen, wobei der
;;; Layer mit dem Textobjekt in allen Fenstern auf ON geschaltet ist.
;;;
;;; Arbeiten mit relativ langen Teststrings, v.a. wenn ber 30 Zeichen.
;;;
;;; Einsatz eines langsam getakteten Prozessors.
;;;
;;; Wir empfehlen, mit einem ausschlieálich im aktuellen Ansichtsfenster
;;; ge”ffneten Layer und nach M”glichkeit kurzen Strings zu arbeiten.
;;;
;;; Folgende Auswahlm”glichkeiten stehen zur Verfgung:
;;;
;;; Command: ptext
;;; Mitte/EDit/EInpassen/Lade-Datei/Rechts/Puffer/<Startpunkt>:
;;;
;;; Bei der Texteingabe werden Ausrichtung nach Links, Rechts, Zentrieren
;;; und Einpassen untersttzt. Die Editierfunktionen dieser Routine arbeiten
;;; mit hoher Wahrscheinlichkeit mit allen Ausrichtungsoptionen der Release
;;; 11, was allerdings noch der šberprfung bedarf.
;;;
;;; Mit den folgenden Cursorbefehlen kann der Benutzer den Cursor in mehreren
;;; Textobjekten bewegt werden.
;;;
;;; ^A -- Ein Blank an die aktuelle Cursorposition anfgen und den
;;; Cursor darauf plazieren.
;;; ^B -- Sprung an den Anfang der Zeile.
;;; ^D -- Cursor eine Zeile tiefer plazieren unter Beibehaltung der
;;; Spaltenposition. Diese Position kann sich allerdings -
;;; abh„ngig vom Kerning eines Zeichenfonts - durchaus ver„ndern.
;;; ^E -- Sprung ans Ende der aktuellen Zeile.
;;; ^H -- Backspace Taste.
;;; ^I -- Schalter fr Einfge/šberschreib-Modus.
;;; ^L -- Cursor nach Links bewegen, ohne das Zeichen zu l”schen.
;;; RETURN -- Return. Die Zeichen rechts vom Cursor werden in die n„chste
;;; Zeile umgebrochen, die restlichen Linien werden eine Zeile
;;; weiter nach unten bewegt.
;;; ^N -- Cursor ans Ende des letzten Textobjektes in der Liste setzen.
;;; ^R -- Cursor eine Position nach Rechts verschieben ohne das Zeichen
;;; zu l”schen.
;;; ^T -- Cursor an den Anfang des ersten Textobjektes in der Liste
;;; setzen.
;;; ^U -- Cursor eine Zeile nach oben bewegen unter Beibehaltung der
;;; Spaltenposition. Die Position kann sich allerdings - abh„ngig
;;; vom Kerning eines Zeichenfonts - durchaus ver„ndern.
;;; ^Z -- Texteingabe beenden.
;;; - -- Bindestrich.
;;; -- Die L”schtaste l”scht das Zeichen unter der momentanen Cursor-
;;; position. Befindet sich dort kein Zeichen und steht der Cursor
;;; am Ende einer Zeile, dann wird die n„chste Zeile - sofern
;;; vorhanden - an die aktuelle Cursorposition angefgt und die
;;; restlichen Zeilen jeweils um eine Zeile nach oben verschoben.
;;;
;;; ^U und ^X sind aufgrund der šberlagerung durch das Betriebssystem
;;; bei DOS- und UNIX-Anlagen vertauscht, so daá jede dieser Kombinationen
;;; den Cursor auf jeder Anlage um eine Zeile nach oben bewegt.
;;;
;;; Lokale Variablen, die die Verschlsselung der Tastencodes fr andere
;;; Tastaturen beinhalten, werden bei Bedarf am Anfang des Programms
;;; - (ptext) defun - aufgefhrt.
;;;
;;;----------------------------------------------------------------------------
(defun ptext (/ pt_ver pt_err pt_oer pt_oe pt_oce pt_sty pt_twf
char insert grp_72 pt_spt pt_rpt str
line_l pt_cl pt_str cont sset j TX:LST ent
pt_ils cont1 ans temp sl pt_rsp pt_msp pt_tsp
return OK2BRK max_j diff nchars dir dstrct pt_obm
pt_te EDIT_T pnding pt_dth
P_SLCK P_BEGL P_HLPD P_HLPU P_DWNL P_ENDL P_BACK
P_ISRT P_JUST P_LEFT P_RTRN P_ENDT P_RGHT P_BEGT
P_UPLD P_UPLU P_QUIT P_SPCE P_HYPH P_DDEL P_UDEL
)
(setq pt_ver 0.90) ; Bei Ver„nderung des Wertes lokal
; zurcksetzen
(if pt_err ; Neue Fehlerroutine starten
(setq pt_oer pt_err)
)
;;
;; Internes Fehlerverhalten lokal definieren
;;
(defun pt_err (s) ; Tritt ein Fehler auf (z.B. CTRL-C)
; solange der Befehl aktiv ist...
(if (/= s "Funktion abgebrochen")
(if (= s "quit / exit abort")
(princ)
(princ (strcat "\nFehler: " s))
)
)
(if (null pt_GEX)
(entdel (cdr(assoc -1 pt_te))) ; L”schen des Probe-Textobjekts
)
(command "zurck" "ende")
(if ll_oe ; Ist eine Fehlerroutine vorhanden
(setq *error* pt_oe) ; dann diese zurcksetzen
)
(setvar "cmdecho" pt_oce) ; Befehl zurcksetzen und Fehlermeldung
(princ) ; ausgeben
)
(if *error* ; Neue Fehlerroutine starten
(setq pt_oe *error* *error* pt_err)
(setq *error* pt_err)
)
(setq pt_oce (getvar "cmdecho")) ; Aktuellen Status der Befehlszeile
; sichern
(setq pt_obm (getvar "blipmode")) ; Aktuellen Blipmode-Status sichern
(setvar "cmdecho" 0) ; Befehlswiederholung ausschalten
(setvar "blipmode" 0) ; Blipmode ausschalten
(command "zurck" "gruppe")
(if (null pt_GEX)
(if (setq temp (cond
((or (= (substr (getvar "PLATFORM") 1 4) "OS/2")
(= (substr (getvar "PLATFORM") 1 3) "DOS"))
(findfile "ptext.exe")
)
((= (substr (getvar "PLATFORM") 1 7) "386 DOS")
(findfile "ptext.exp")
)
(T
(findfile "ptext")
)
)
)
(if (null (xload temp))
(progn
(princ "\nKann das Programm Ptext nicht laden. ")
(if (and pt_sup pt_uls get_ch pt_gll pt_cll pt_psl
is_num pt_csl pt_gpl pt_gpr pt_sjk pt_mc
pt_bul pt_sil pt_ael pt_ail pt_ats pt_pnl
pt_pl pt_gmp pt_waw pt_pww pt_pee pt_mne
pt_fww pt_dal dr_txt round)
(princ "\nAutoLispversion l„uft. ")
(progn
(princ "\nDie Version ben”tigt Ptext.lsp. ")
(exit)
)
)
)
(princ "\n\n\nDie ADS-Version von PTEXT l„uft. ")
)
(if (and pt_sup pt_uls get_ch pt_gll pt_cll pt_psl
is_num pt_csl pt_gpl pt_gpr pt_sjk pt_mc
pt_bul pt_sil pt_ael pt_ail pt_ats pt_pnl
pt_pl pt_gmp pt_waw pt_pww pt_pee pt_mne
pt_fww pt_dal dr_txt round)
(progn
(princ "\nKann Ptext nicht finden. ")
(princ "\nAutoLispversion l„uft. ")
)
(progn
(princ "\nKann Ptext nicht finden. ")
(princ "\nDie Version ben”tigt Ptext.")
(exit)
)
)
)
(princ "\n\n\nDie ADS-Version von PTEXT l„uft. ")
)
;; Hier die Maschinencodes fr die verschiedenen Cursorbewegungen in
;; UNIX und DOS, die durch Aufrufe in (ads_grread) protokolliert werden.
;;
;; Bitte beachten: UNIX-Anlagen sind in der Lage, sowohl die Low-Level-Codes
;; als auch die Funktion der L™SCH- und Backspace-Taste ebenso wie andere
;; neu zu definieren. Es ist durchaus m”glich, daá sie anders reagieren,
;; als in der Dokumentation angegeben. Daher sollten die durch (grread)
;; zurckgegebenen Codes durch Drcken der entsprechenden Tasten mit der
;; unten stehenden Tabelle verglichen werden, um die neu zu definierenden
;; Codes herauszufinden.
;;
;; M”glicherweise mssen sie an die entsprechenden L„ndercodes angepaát
;; werden.
;;
;; Die hier aufgelisteten Codes werden nur dann gebraucht, wenn das
;; ablauff„hige PTEXT nicht benutzt wird. Um den Rckgabecode einer Taste
;; zu ver„ndern, muá der Quellcode des ausfhrbaren Moduls ver„ndert und
;; neu kompiliert werden, wie im ADS Benutzerhandbuch beschrieben.
(if (null pt_GEX)
(setq P_APPN 1 ; ^A Einen Blank an pt_rsp anfgen.
P_BEGL 2 ; ^B Zeilenanfang.
P_DWNL 4 ; ^D Eine Zeile tiefer.
P_ENDL 5 ; ^E Zeilenende.
P_BACK 8 ; ^H Backspace.
P_ISRT 9 ; ^I Schalter Einfge/šberschreib-Modus.
P_LEFT 12 ; ^L Cursor Links - nicht berschreiben.
P_RTRN 13 ; Return.
P_ENDT 14 ; ^N Textende.
P_RGHT 18 ; ^R Cursor Rechts - nicht berschreiben.
P_BEGT 20 ; ^T Textanfang.
P_UPLD 21 ; ^U Eine Zeile h”her (DOS).
P_UPLU 24 ; ^X Eine Zeile h”her (UNIX).
P_QUIT 26 ; ^Z Texteingabe Ende.
P_SPCE 32 ; Leertaste.
P_HYPH 45 ; - Bindestrich.
P_UDEL 127 ; Zeichen l”schen (UNIX).
P_DDEL 211 ; Zeichen l”schen (DOS).
P_HLPD 222 ;^F1 Hilfefunktion unter DOS
P_HLPU 31 ;^? Hilfefunktion unter UNIX
)
)
(setq pt_sty (tblsearch "style" (getvar "textstyle"))
pt_dth (cdr(assoc 42 pt_sty))
pt_twf (cdr(assoc 41 pt_sty))
P_SLCK 0 ; Keine Zeichen im Puffer
char P_SPCE ; "Leerzeichen"
insert T ; In Einfgemodus springen.
)
;; Einen gefrorenen Layer einrichten, um die L„nge eines Textstrings zu
;; ermitteln.
(if (null (setq temp (tblsearch "layer" "frozen_text")))
(command "layer" "neu" "frozen_text" "frieren" "frozen_text" "")
(if (= (logand (cdr(assoc 70 temp)) 1) 0)
(command "layer" "frieren" "frozen_text" "")
(princ)
)
)
(if (= (getvar "handles") 0) ; REFERENZ ist AUS
(progn
(initget "Ja Nein")
(if (= (getkword "\nReferenz einschalten? <J>: ") "Nein")
(progn
(princ
"\nHANDLES mssen fr dieses Programm eingeschalten sein. ")
(exit)
)
(command "referenz" "ein")
)
)
)
(if (null pt_GEX)
(progn
;; Ein Textobjekt als Dummy auf diesem Layer einrichten.
(command "text" "r" "0,0" "" "" "Ptext")
(setq pt_te (entget(entlast))
pt_te (subst (cons 8 "frozen_text") (assoc 8 pt_te) pt_te)
)
(entmod pt_te)
)
)
(princ "\nThe Paragraph Text Editor, Version ")
(princ (rtos pt_ver 2 2))
(princ ", (c) 1990 by Autodesk, Inc. ")
(pt_opt) ; Auswahloption des Benutzers einlesen
(if (null EDIT_T)
(progn
(pt_sth) ; Texth”he bestimmen.
(if (/= grp_72 5)
(pt_sra) ; Drehungswinkel bestimmen.
(setq pt_ra (angle pt_spt pt_rpt))
)
(setq pt_ils (pt_sis)) ; Zeilenzwischenraum bestimmen.
(if (/= grp_72 5)
(pt_sml) ; Zeilenl„nge bestimmen.
(setq pt_mll (distance pt_spt pt_rpt))
)
)
)
(if (null str)
(setq str T)
)
(grtext -2 "Ptext: Insert mode")
(if (null pt_GEX)
(progn
(setq line_l 0
pt_cl 0
pt_str ""
)
(while (/= str "")
(pt_sup) ; SETUP durchfhren
(while (get_ch) ; Zeichen einlesen
;; Maximale Zeilenl„nge einschlieálich Puffer noch nicht ausgesch”pft..
(if (< line_l pt_mll)
(pt_pl) ; Zeile ausfhren
(progn
(setq temp (pt_waw)) ; Wortumbruch vorbereiten
(pt_pww temp) ; Wortumbruch durchfhren
)
)
(setq char nil)
)
)
)
(progn
(setq EDIT_T (if (null EDIT_T) 0 1))
(if (null pt_rpt) (setq pt_rpt (list 0.0 0.0 0.0)))
(setq pt_sty (cdr(assoc 2 pt_sty)))
(setq err
(pt_GEX pt_spt pt_rpt grp_72 pt_th pt_ra
pt_mll pt_ils pt_ver pt_sty EDIT_T)
)
)
)
(if (null pt_GEX)
(entdel (cdr(assoc -1 pt_te))) ; Probe-Textobjekt l”schen.
)
(command "zurck" "ende")
(setvar "blipmode" pt_obm) ; Blipmode einschalten
(setvar "cmdecho" pt_oce) ; Befehlswiederholung einschalten
(princ)
)
;;;
;;; Auswahlm”glichkeiten einlesen
;;;
;;; pt_opt == PText_OPTions
;;;
(defun pt_opt (/ cont)
(setvar "cmdecho" 0)
(while (null cont)
(setq cont T)
(initget "Mitte EDit EInpassen Lade-Datei Rechts Puffer ?")
(setq pt_spt (getpoint
"\nMitte/EDit/EInpassen/Rechts/Puffer/?/<Startpunkt>: "))
(cond
((= pt_spt "Mitte")
(setq grp_72 1)
(initget 1)
(setq pt_spt (getpoint "\nMitte der Basislinie: "))
(setq pt_spt (trans pt_spt 1 0))
)
((= pt_spt "EDit")
(princ (strcat
"\nZu editierenden Text w„hlen. Bitte mit der ersten Zeile "
"\ndes Absatzes beginnen und dann der Reihenfolge nach w„hlen"))
(setq sset (ssget))
(if sset
(progn
(setq j 0)
(setq temp (entget (ssname sset j))
ename1 (cdr(assoc -1 temp))
k (cdr(assoc 210 temp))
fd (open "ptext.hdl" "w")
)
(if (null fd)
(progn
(princ
"\nKann HANDLE-Datei \"ptext.hdl\" nicht zum Schreiben ”ffnen. ")
(exit)
)
)
(if (> (sslength sset) 1)
(setq temp (entget (ssname sset (1+ j)))
ename2 (cdr(assoc -1 temp))
)
)
(repeat (sslength sset)
(if (null pt_GEX)
(progn
(if (= (cdr(assoc 0 (entget (ssname sset j)))) "TEXT")
(setq TX:LST (if TX:LST
(append TX:LST (list (ssname sset j)))
(list (ssname sset j))
)
j (1+ j)
)
)
)
(progn
(if (and
(= (cdr(assoc 0 (entget (ssname sset j)))) "TEXT")
(equal (cdr(assoc 210 (entget (ssname sset j)))) k)
)
(progn
(if (> j 0) (princ "\n" fd))
(princ (cdr(assoc 5 (entget (ssname sset j)))) fd)
)
)
(setq j (1+ j))
)
)
)
(if (null pt_GEX)
(setq ent (entget(nth 0 TX:LST)))
(progn
(close fd)
(setq ent (entget(ssname sset 0)))
)
)
(setq pt_spt (cdr(assoc 10 ent))
str (cdr(assoc 1 ent))
pt_th (cdr(assoc 40 ent))
pt_ra (cdr(assoc 50 ent))
grp_72 (cdr(assoc 72 ent))
)
(if (= grp_72 5) ; Text einpassen
(setq pt_rpt (cdr(assoc 11 ent))
pt_mll (distance pt_spt pt_rpt)
)
(setq pt_mll (pt_sml)) ; Maximale Zeilenl„nge festlegen
)
(setq pt_ils (pt_gis) ; Zeilenabstand festlegen.
EDIT_T T ; Flag fr Editierfunktion setzen.
)
)
(progn
(setq cont nil) ; Erste Auswahlzeile wiederholen.
(princ "\nKeine Text-entities gew„hlt. ")
)
)
)
((= pt_spt "EInpassen")
(setq grp_72 5)
(initget 1)
(setq pt_spt (getpoint "\nLinker Punkt der Basislinie: "))
(initget 1)
(setq pt_rpt (getpoint pt_spt "\nRechter Punkt der Basislinie: "))
(setq char nil)
(setq pt_spt (trans pt_spt 1 0))
(setq pt_rpt (trans pt_rpt 1 0))
)
((= pt_spt "Rechts")
(setq grp_72 2)
(initget 1)
(setq pt_spt (getpoint "\nRechter Punkt der Basislinie: "))
(setq pt_spt (trans pt_spt 1 0))
)
((= pt_spt "Puffer")
(setq cont nil)
(if (null P_SLCK) (setq P_SLCK 1))
(initget 4)
(setq pt_spt (getint (strcat
"\nAnzahl der Buchstaben im Puffer <" (itoa P_SLCK) ">: ")))
(if pt_spt (setq P_SLCK pt_spt))
)
((= (type pt_spt) 'LIST) ; Ein Punkt wurde eingegeben
(setq grp_72 0)
(setq pt_spt (trans pt_spt 1 0))
)
((= pt_spt "?")
(pt_phs T)
(setq cont nil)
)
(T
(command "zurck" "ende")
(exit) ; Keine Eingabe -- Ende.
)
)
)
)
;;;
;;; Der Hilfebildschirm.
;;;
;;; pt_phs == PText_Print_Help_Screens
;;;
(defun pt_phs (temp)
(if textpage (textpage) (textscr))
(if temp
(progn
(princ
"\nDer Text kann in einer der folgenden Weisen eingegeben werden;\nLinks, Mitte, Rechts,")
(princ "\noder eingepasst werden.Bewegen Sie den Cursor zu einer beliebigen Position")
(princ "\nin dem Text in dem Sie Ihre Eingaben machen m”chten")
(princ
"\noder m”chten Sie bereis existierende Zeilen editieren und dazu")
(princ "\ndie Edit-Option verwenden.")
(princ "\n")
(princ
"\nSie mssen die Entities in der Reihenfolge w„hlen, in der Sie diese")
(princ "\neditieren m”chten oder Text hinzufgen m”chten.")
(princ
"\nvielleicht muss die Zeile getrennt werden, die Sie ausgew„hlt haben ")
(princ "\n ")
(princ
"\nDie folgenden Kontrolltasten erlauben ein \"Cursor\" gesteuertes ")
(princ "\narbeiten und setzen durch Unterstreichen oder šberstreichen Kontrollcodes ")
(princ "\num die Entities zu verschieben.")
(princ "\n")
(princ "\n<more>")
(grread)
(princ "\r ")
)
)
(if temp
(progn
(princ "\n ^F1 (DOS) oder ")
(princ "\n ^? (UNIX) -- Hilfe-Bildschirm ")
)
)
(princ "\n")
(princ "\n ^A -- Ein Blank an die aktuelle Cursorposition anfgen und den ")
(princ "\n Cursor darauf plazieren.")
(princ "\n ^B -- Sprung an den Anfang der Zeile.")
(princ
"\n ^D -- Cursor eine Zeile tiefer plazieren unter Beibehaltung der ")
(princ "\n Spaltenposition. Diese Position kann sich allerdings - ")
(princ "\n abh„ngig vom Kerning eines Zeichenfonts - durchaus ver„ndern.")
(princ "\n ^E -- Sprung ans Ende der aktuellen Zeile.")
(princ "\n ^H -- Backspace Taste.")
(princ "\n ^I -- Schalter fr Einfge/šberschreib-Modus.")
(princ "\n ^L -- Cursor nach Links bewegen, ohne das Zeichen zu l”schen.")
(if temp
(progn
(princ "\n RETURN -- Return. Die Zeichen rechts vom Cursor werden in die n„chste ")
(princ "\n Zeile umgebrochen, die restlichen Linien werden eine Zeile ")
(princ "\n weiter nach unten bewegt. ")
)
)
(princ "\n ^N -- Cursor ans Ende des letzten Textobjektes in der Liste setzen.")
(princ "\n ^R -- Cursor nach rechts verschieben.")
(princ "\n ^T -- Cursor an den Anfang des ersten Textobjektes in der Liste ")
(princ "\n setzen ")
(princ "\n ^U -- Cursor nach oben bewegen.")
(princ "\n ^Z -- Texteingabe beenden.")
(princ "\n")
(if (null temp)
(progn
(princ "\nBeliebige Taste drcken um zur Zeichnung zu gelangen.")
(grread)
(princ "\r ")
(princ "\n")
(princ "\n")
(princ "\nText: ")
(princ str)
)
)
(if temp
(progn
(princ "\n<more>")
(grread)
(princ "\r ")
(princ
"\n DELETE -- Die DEL Taste l”scht den aktuellen Buchstaben. ")
(princ
"\n Falls der Cursor sich am Ende einer Zeile befindet werden ")
(princ "\n more lines in the list, then the next line is ")
(princ
"\n die anderen Zeilen um eine Zeile nach oben plaziert ")
(princ "\n ")
(princ
"\nWird ein Trennungsstrich nach einem Wort eingefgt, wird das Wort")
(princ "\nnach dem Trennungsstrich getrennt.")
(princ "\n")
)
)
(princ)
)
;;;
;;; H”he der Textobjekte festlegen.
;;; Default-Wert auf "0.2" setzen, falls nicht in der STIL-Symboltabelle
;;; anders festgelegt.
;;;
;;; pt_sth == PText_Set_Text_Height
;;;
(defun pt_sth ()
(initget 6)
(setq ans (getdist (trans pt_spt 0 1) (strcat "\nTexth”he <"
(if pt_th (rtos pt_th) (rtos pt_dth))
">: ")))
(if ans
(setq pt_th ans)
(if (null pt_th)
(setq pt_th 0.2)
)
)
)
;;;
;;; Drehwinkel fr Textobjekte festlegen.
;;; Default-Wert auf "0" setzen, falls nicht in der STIL-Symboltabelle anders
;;; festgelegt.
;;;
;;; pt_sra == PText_Set_Rotation_Angle
;;;
(defun pt_sra ()
(if (= (logand (cdr(assoc 70 pt_sty)) 4) 4)
(setq temp 270)
(setq temp 0)
)
(setq ans (getorient (trans pt_spt 0 1) (strcat
"\nDrehwinkel <" (if pt_ra (angtos pt_ra) (itoa temp)) ">: ")))
(if ans
(setq pt_ra ans) ; in Rad
(setq pt_ra (/ temp (/ 180 pi)))
)
)
;;;
;;; Abstand zwischen den Basislinien der Textzeilen festlegen
;;; Default-Wert: Texth”he mal 1,5
;;; Als Gruppen Code muá "Temp" gew„hlt werden.
;;;
;;; pt_gis == PText_Get_Interline_Spacing
;;;
(defun pt_gis (/ temp)
(if (> (sslength sset) 1)
(progn
(if (or (= grp_72 0) (= grp_72 5))
(setq temp 10)
(setq temp 11)
)
(distance (cdr(assoc temp (entget ename1)))
(cdr(assoc temp (entget ename2)))
)
)
(progn
(setq pt_ils (pt_sis))
)
)
)
;;;
;;; Abstand zwischen den Basislinien der Textzeilen festlegen.
;;; Defaultwert: Texth”he mal 1,5
;;;
;;; pt_sis == PText_Set_Interline_Spacing
;;;
(defun pt_sis ()
(setq pt_ils (* pt_th 1.5))
(initget 6)
(setq ans (getdist (trans pt_spt 0 1) (strcat
"\nZeilenabstand <" (if pt_ils (rtos pt_ils) "0.3") ">: ")))
(if ans
(if (= (logand (cdr(assoc 70 pt_sty)) 4) 4)
(- ans)
ans
)
(if (= (logand (cdr(assoc 70 pt_sty)) 4) 4)
(- (* 1.5 (if pt_th pt_th 0.2)))
(* 1.5 (if pt_th pt_th 0.2))
)
)
)
;;;
;;; Maximale Zeilenl„nge festlegen.
;;; Default-Wert: 2 Einheiten.
;;; Legt die globale Variable pt_mll fest.
;;;
;;; pt_sml == PText_Set_Maximum_line_Length
;;;
(defun pt_sml ()
(if (null pt_mll)
(setq pt_mll (* pt_th 10.0))
)
(initget 6)
(setq ans (getdist (trans pt_spt 0 1) (strcat
"\nMaximale Zeilenl„nge" (if pt_mll
(strcat " <" (rtos pt_mll) ">: ")
": ")))
)
(if ans
(setq pt_mll ans)
)
(+ pt_mll (* 0.9 P_SLCK pt_twf pt_th))
)
;;;
;;; Alle Funktionen, die im Folgenden definiert sind bis einschlieálich der
;;; Definition der C:-Funktion am Ende der Datei sind in PTEXT.C ebenfalls
;;; vorhanden, um den PTEXT-Befehl auch ohne Aufruf einer ADS-Routine
;;; auszufhren. Ein Probelauf beider Versionen verdeutlicht den Unterschied
;;; in der Ablaufgeschwindigkeit des Befehls - einerseits als reine AutoLisp
;;; Applikation gegenber einer ber ADS transformierten Applikation.
;;;
;;; Um die AutoLisp-Version zu starten, muá PTEXT als ausfhrbare Routine
;;; umbenannt und anschlieáend gestartet werden. Sollte die Routine kein
;;; ausfhrbares Programm namens PTEXT auffinden (Namenszusatz ver„ndert),
;;; wird die AutoLisp-Version gestartet. Andernfalls wird die ADS-Version
;;; geladen und gestartet.
;;;
;;; Ist abzusehen, daá die AutoLisp-Version niemals zum Einsatz kommt, kann
;;; der folgende Programmcode bis einschlieálich der C: Definitionen gel”scht
;;; werden.
;;;
;;; ------------------ Hier abschneiden --------------------------
;;;
;;; Vor šbernahme der Tastatureingaben Setup durchfhren.
;;;
;;; Der Z„hler "pt_cl" z„hlt die aktuelle Zeile, beginnend mit "1". Er ist
;;; stets um eins grӇer als die Zahl, die im Lisp-Ausdruck (nte <n> <list>)
;;; verwendet wird und die stets bei "0" beginnt. Dieser Z„hler wird immer
;;; abgeprft, wenn Textobjekte aus der Liste TX:LST angesprochen werden.
;;;
;;; pt_sup == PText_Set_UP
;;;
(defun pt_sup ()
(setq pt_rsp 1
char P_SPCE
pt_cl (1+ pt_cl)
pt_vsp 1
)
(setq str (if (= (type str) 'STR) str (chr char))
strlst (pt_psl str) ; String in Liste einlesen
pt_msp (pt_cll (length strlst) T) ; Zeilenl„nge ermitteln
pt_rsp (pt_cll pt_vsp nil) ; Zeichenposition- und GrӇe ermitteln
pt_str (pt_uls str pt_rsp) ; Zeichen "1" unterstreichen.
)
(if ent
(progn
(setq ent (subst (cons 1 pt_str) (assoc 1 ent) ent))
(entmod ent)
)
(progn
(dr_txt pt_str) ; Textstring schreiben
(setq TX:LST (if TX:LST
(pt_ael (cdr(assoc -1 ent)) pt_cl TX:LST)
(list (cdr(assoc -1 ent)))
)
)
)
)
(princ "\nText: ")
(princ str)
)
;;;
;;; Unterstreichoption fr ermittelte Zeichenposition (j) in einem String (s)
;;; einschalten. String mit Unterstrich versehen zurckgeben.
;;;
;;; pt_uls == PText_UnderLine_String
;;;
(defun pt_uls (s j / temp)
(setq temp (strlen s))
(if (> temp 0)
(if (and (> j 0) (<= j temp))
(strcat (substr s 1 (pt_csl 1 j))
(strcat "%%u" (if insert "" "%%o")
(nth (1- j) strlst)
"%%u" (if insert "" "%%o")
)
(substr s (1+ (pt_csl 1 (1+ j))))
)
(strcat (substr s 1 (pt_csl 1 j)) "%%u %%u")
)
"%%u %%u"
)
)
;;;
;;; Ein Zeichen von Tastatur einlesen
;;;
;;;
(defun get_ch (/ return)
;; Auáer ber Tastatur keine weiteren Eingaben zulassen.
(while (/= (car (setq char (grread nil))) 2) (princ))
(setq char (cadr char))
(cond
((= char P_RTRN)
(pt_pnl) ; Neue Zeile verarbeiten
(setq return nil)
)
((= char P_ISRT)
(if insert ; Einfgemodus einschalten...
(progn
(setq insert nil)
(grtext -2 "Ptext: šberschreibmodus")
)
(progn
(setq insert T)
(grtext -2 "Ptext: Einfgemodus")
)
)
(setq return T)
)
;; Backspace Taste -- Cursor l”scht
((= char P_BACK)
(pt_mc "Links" T) ; Cursor bewegen
(setq return T)
)
((or (= char P_DDEL)
(= char P_UDEL)) ; L”schtaste
(pt_mc "DEL" nil)
(setq return T)
)
;; ALT - A Taste -- Leerschritt an aktuelle Cursorposition anfgen.
((= char P_APPN)
(setq char P_SPCE)
(setq pt_rsp (pt_ats char T)) ; Zeichen an String anfgen
(pt_mc "RIGHT" nil) ; Cursor bewegen
(setq return T)
)
((= char P_BEGL) ; ALT - B Taste : Zeilenanfang
(pt_mc "HOME" nil)
(setq return T)
)
((= char P_DWNL) ; ALT - D Taste : Eine Zeile tiefer
(pt_mc "DOWN" nil)
(setq return T)
)
((= char P_ENDL) ; ALT - E Taste : Zeilenende
(pt_mc "END" nil)
(setq return T)
)
((= char P_LEFT) ; ALT - L Taste : Bewegung nach Links
(pt_mc "LEFT" nil)
(setq return T)
)
((= char P_ENDT) ; ALT - N Taste : Sprung nach Textende
(pt_mc "BOTTOM" nil)
(setq return T)
)
((= char P_RGHT) ; ALT - R Taste : Bewegung nach rechts
(pt_mc "RIGHT" nil)
(setq return T)
)
((= char P_BEGT) ; ALT - T Taste : Sprung nach Textanfang
(pt_mc "TOP" nil)
(setq return T)
)
((or (= char P_UPLD)
(= char P_UPLU)) ; ALT - U Taste : (DOS or UNIX)
(pt_mc "UP" nil)
(setq return T)
)
((= char P_QUIT) ; ALT - Z Taste -- Ende.
(initget "Ja Nein")
(if (= (getkword "\nText verlassen ? <J>: ") "Nein")
(progn
(setq return T)
(princ "\nText: ")
(princ str)
)
(progn
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
(setq str ""
return nil
)
)
)
)
((= char P_DEL) ; L”schen -- Zeichen unter Cursor l”schen
(pt_mc "DEL" nil)
(setq return T)
)
((or (= char P_HLPD) (= char P_HLPU)) ; ^F1 or ^? -- Hilfe-Bildschirm.
(pt_phs nil)
(setq return T)
)
((= (chr char) "%")
(cond
((= pnding nil) (setq pnding 1))
((= pnding 1) (setq pnding 2))
((= pnding 2) (setq pnding nil))
(T
(exit)
)
)
(setq pt_rsp (pt_ats char nil)
pt_vsp (pt_cll pt_rsp T)
)
(setq return T)
)
; Andernfalls "T" zurckgeben
(T
(if (= char P_HYPH)
(setq OK2BRK T)
(setq OK2BRK nil)
)
(if (> pnding 1)
(cond
((or (= (chr char) "o") ; šberstrich
(= (chr char) "u") ; Unterstrich
(= (chr char) "d") ; Grad
(= (chr char) "p") ; Plus/Minus
(= (chr char) " ") ; Leerschritt
)
(setq pt_rsp (- (pt_ats char nil) 2)
strlst (pt_psl str) ; String in Liste einlesen
pt_vsp (pt_cll pt_rsp T)
pnding nil
)
)
((print (is_num (chr char)))
(terpri)
(if (< pnding 4)
(setq pt_rsp (pt_ats char nil)
pnding (1+ pnding)
pt_vsp (pt_cll pt_rsp T)
)
(setq pt_rsp (- (pt_ats char nil) (- pnding 2))
strlst (pt_psl str) ; Parse string to list
pnding nil
pt_vsp (pt_cll pt_rsp T)
)
)
)
(T
(setq pt_rsp (pt_ats char nil)
pt_vsp (pt_cll pt_rsp T)
pnding nil
)
)
)
(setq pt_rsp (pt_ats char nil)
pt_vsp (pt_cll pt_rsp T)
)
)
(setq return T) ; Wert zurckgeben
)
)
(if (/= char P_RTRN)
(progn
;; Aktuelle Stringposition (pt_vsp) einsetzen, hierbei auch Steuer-
;; zeichencodes wie %%d oder %%p zulassen.
(setq pt_rsp (pt_cll pt_vsp nil)
;; String fr Bildschirmausgabe mittels (entmod) aufbereiten.
pt_str (pt_uls str pt_rsp)
;; H”chstm”gliche Stringposition (pt_msp) einsetzen, hierbei auch
;; Steuerzeichencodes wie %%d oder %%p zulassen.
pt_msp (pt_cll (length strlst) T)
;; Zeilenl„nge auf momentan erreichte Stringposition festlegen.
line_l (pt_gll (pt_csl 1 pt_rsp))
)
)
)
return
)
;;;
;;; L„nge einer Textzeile mit Hilfe eines Textobjektes als Dummy auf dem
;;; gefrorenem Textlayer ermitteln. Dieses Objekt enth„lt den aktuellen Text-
;;; string bis zur augenblicklichen Cursorposition ohne Unterstrich/šberstrich-
;;; Attribute.
;;;
;;; Entfernung zwischen rechtem und linkem Punkt des nach rechts ausgerichteten
;;; Textstrings.
;;;
;;; pt_gll == PText_Get_Line_Length
;;;
(defun pt_gll (pt_rsp)
(setq pt_te (subst (cons 1 (pt_sjk 1 pt_rsp)) (assoc 1 pt_te) pt_te))
(entmod pt_te)
(setq pt_te (entget(cdr(assoc -1 pt_te))))
(distance (cdr(assoc 10 pt_te)) (cdr(assoc 11 pt_te)))
)
;;;
;;; Stringliste "strlst" auf Steuerzeichen berprfen. Ist "diff" gleich "T",
;;; dann Rckgabe der Anzahl sichtbarer Zeichen, ansonsten Rckgabe der Nummer
;;; des Ausdrucks in der Liste, die mit der momentan aktuellen Stringposition
;;; bereinstimmt. N_chars ist in dieser Routine global definiert und gibt an,
;;; wieviele Zeichen beim L”schen eines speziellen Symbols gel”scht werden
;;; sollen.
;;;
;;; pt_cll == PText_Check_Line_Length
;;;
(defun pt_cll (max diff / temp j)
(setq temp 0
j 0
k 0
nchars 0 ; eigentlich global, in (ptext) lokal.
)
(while (and (< k max) (< j (length strlst)))
(cond
((or (= (nth j strlst) "%%o") ; berstreichen
(= (nth j strlst) "%%u")) ; unterstreichen
(if diff
(setq k (1+ k))
)
(setq j (1+ j))
)
(T
(setq temp (1+ temp) ; Z„hler Differenz
nchars (strlen (nth j strlst))
j (1+ j)
k (1+ k)
)
)
)
)
(if diff (if (> temp 0) temp 1) j)
)
;;;
;;; Den String "str" in eine Reihe von Strings untergliedern und zwar getrennt
;;; nach Einzelstrings fr abdruckbare Zeichengruppen oder Steuerzeichen.
;;; N_chars ist in dieser Routine global definiert und gibt an, wieviele
;;; Zeichen beim L”schen eines speziellen Symbols gel”scht werden sollen.
;;;
;;; pt_psl == PText_Parse_String_to_List
;;;
(defun pt_psl (str / max temp j k tmplst)
(setq max (strlen str)
j 1
k 0
x 1
nchars 0 ; eigentlich global, In (ptext) lokal.
)
(while (<= j (strlen str))
(if (= (setq temp (substr str j 1)) "%")
(progn
(if (= (substr str (setq j (1+ j)) 1) "%")
(progn
(setq j (1+ j))
(cond
((= (substr str j 1) " ") ; space
(setq tmplst (if tmplst
(append tmplst (list "%" "%" " "))
(list "%" "%" " ")
)
)
)
((or (= (substr str j 1) "%") ; Prozent
(= (substr str j 1) "d") ; Grad
(= (substr str j 1) "p") ; Plus/Minus
(= (substr str j 1) "o") ; šberstreichen
(= (substr str j 1) "u")) ; Unterstreichen
(setq temp (substr str (- j 2) 3)
j (1+ j)
)
)
((is_num (substr str j 1))
(while (and (< k 3) (is_num (substr str (+ j k) 1)))
(setq k (1+ k))
)
(setq temp (substr str (- j 2) (+ 2 k))
j (+ j k)
)
)
(T
(setq j (1+ j))
)
)
(setq tmplst (if tmplst
(append tmplst (list temp))
(list temp)
)
)
)
(progn
(setq tmplst (if tmplst
(append tmplst (list temp))
(list temp)
)
tmplst (append tmplst (list (substr str j 1)))
j (1+ j)
)
)
)
)
(progn
(setq tmplst (if tmplst
(append tmplst (list temp))
(list temp)
)
j (1+ j)
)
)
)
)
tmplst
)
;;;
;;; Ist das Zeichen (der String) eine Zahl...
;;;
;;;
(defun is_num (char)
(if
(or
(= char "0") (= char "1") (= char "2") (= char "3") (= char "4")
(= char "5") (= char "6") (= char "7") (= char "8") (= char "9")
)
T
nil
)
)
;;;
;;; Anzahl der Zeichen in den Strings vom Anfang bis zur aktuellen Position
;;; im String ermitteln.
;;;
;;; pt_csl == PText_Count_String_Length
;;;
(defun pt_csl (j k / temp)
(setq temp 0)
(while (and (> j 0) (< j k) (<= j (length strlst)))
(setq temp (+ temp (strlen (nth (1- j) strlst)))
j (1+ j)
)
)
temp
)
;;;
;;; Stringposition des n„chsten abdruckbaren Zeichens links von der aktuellen
;;; Cursorposition ermitteln.
;;;
;;; pt_gpl == PText_Get_next_start_Position_Left
;;;
(defun pt_gpl (temp)
(setq j (pt_cll temp T))
(while (and (> temp 0) (= j (setq k (pt_cll temp T))))
(setq temp (1- temp))
)
k
)
;;;
;;; Stringposition des n„chsten abdruckbaren Zeichens rechts von der aktuellen
;;; Cursorposition ermitteln.
;;;
;;; pt_gpr == PText_Get_next_start_Position_Right
;;;
(defun pt_gpr (temp)
(pt_cll temp nil)
)
;;;
;;; Strings aus der Liste "strlst" von Position "j" bis Position "k" zu einem
;;; String verketten.
;;; String zurckgeben oder "".
;;;
;;; pt_sjk == PText_Strcat_from_J_to_K
;;;
(defun pt_sjk (j k / temp)
(setq temp 0
l 0
)
(if (and (<= j (length strlst)) (<= j k))
(progn
(while (< temp (+ j l))
(if (or (= (nth temp strlst) "%%o") ; šberstreichen
(= (nth temp strlst) "%%u")) ; Unterstreichen
(setq l (1+ l))
)
(setq temp (1+ temp))
)
(setq temp "")
(while (and (<= (+ j l) (length strlst)) (<= j k))
(setq temp (strcat temp (nth (1- (+ j l)) strlst)))
(if (or (= (nth (1- (+ j l)) strlst) "%%o") ; šberstreichen
(= (nth (1- (+ j l)) strlst) "%%u")) ; Unterstreichen
(setq k (1+ k))
)
(setq j (1+ j))
)
)
(setq temp "")
)
temp
)
;;;
;;; Den Cursor in die in "dir" definierte Richtung bewegen und - falls das
;;; zweite Argument gleich "T" ist, das Zeichen unter der neuen Cursorposition
;;; l”schen.
;;;
;;; pt_mc == PText_Move_Cursor
;;;
(defun pt_mc (dir dstrct)
(cond
((= dir "LEFT")
(if dstrct ; Text l”schen
(if (> pt_vsp 1) ; Falls nicht am Anfang einer Zeile,
;; ein abdruckbares Zeichen von der aktuellen Position abziehen.
(progn
(setq pt_vsp (1- pt_vsp)
pt_rsp (pt_cll pt_vsp nil)
str (strcat
(pt_sjk 1 (- pt_vsp 1))
(pt_sjk (1+ pt_vsp) pt_msp)
)
strlst (pt_psl str) ; String zergliedern
)
(repeat 5
(princ (chr P_BACK))
(princ (chr P_SPCE))
(princ (chr P_BACK))
)
)
(progn ; Am Anfang einer Textzeile...
(if (> pt_cl 1) ; falls nicht gerade die erste Zeile...
(pt_dal T) ; Backup fr eine Zeile, l”schen
)
)
)
(if (> pt_vsp 1) ; Text NICHT l”schen...
(setq pt_vsp (1- pt_vsp)
pt_rsp (pt_gpl pt_vsp)
)
(if (> pt_cl 1) ; falls nicht gerade die erste Zeile...
(pt_dal nil) ; Backup fr eine Zeile, nicht l”schen
)
)
)
)
((= dir "RIGHT")
(if dstrct ; Text berschreiben
(if (< pt_vsp pt_msp) ; nicht am Ende einer Zeile
(setq pt_vsp (1+ pt_vsp)
pt_rsp (pt_gpr pt_vsp)
str (strcat
(pt_sjk 1 (- pt_rsp 2))
" "
(pt_sjk pt_rsp pt_msp)
)
strlst (pt_psl str) ; String zergliedern
)
)
)
(if (< pt_vsp pt_msp) ; Text NICHT l”schen ...
; NICHT am Ende einer Zeile...
(setq pt_vsp (1+ pt_vsp)
pt_rsp (pt_gpr pt_vsp)
)
;; andernfalls
(if (< pt_cl (length TX:LST)) ; Am Ende einer Zeile...
;; Falls nicht in der letzten Zeile in der Editierliste...
(progn
;; Aktuelles Objekt modifizieren, Cursor l”schen.
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
(setq pt_cl (1+ pt_cl) ; Zeilenz„hler um eins erh”hen
;; ENAME aus TX:LST fr neue aktuelle Zeile bereitstellen.
ent (entget(nth (1- pt_cl) TX:LST))
;; String in "ent" einlesen
str (cdr(assoc 1 ent))
;; Tats„chlich unterstrichene Positionen in (get_ch)
;; berprfen
pt_rsp 1
)
)
;; Andernfalls nichts machen.
)
)
)
((= dir "HOME")
;; Tats„chlich unterstrichene Positionen in (get_ch) berprfen
(setq pt_vsp 1)
)
((= dir "END")
;; Tats„chlich unterstrichene Positionen in (get_ch) berprfen
(setq pt_vsp pt_msp)
)
((= dir "TOP")
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
(setq pt_cl 1
ent (entget(nth 0 TX:LST))
str (cdr(assoc 1 ent))
strlst (pt_psl str) ; String in Liste zergliedern
;; Tats„chlich unterstrichene Position in (get_ch) berprfen
pt_vsp 1
)
)
((= dir "BOTTOM")
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
(setq pt_cl (length TX:LST)
ent (entget(last TX:LST))
str (cdr(assoc 1 ent))
strlst (pt_psl str) ; String in Liste zergliedern
;; Tats„chlich unterstrichene Position in (get_ch) berprfen
pt_vsp pt_msp
)
)
((= dir "DEL")
(if (< pt_vsp pt_msp) ; falls nicht am Zeilenende...
(progn
(setq temp (strlen str)
str (strcat
(pt_sjk 1 (1- pt_rsp))
(pt_sjk (1+ pt_rsp) pt_msp)
)
strlst (pt_psl str) ; String in Liste
)
(repeat (1+ (- temp (strlen str)))
(princ (chr P_BACK))
(princ (chr P_SPCE))
(princ (chr P_BACK))
)
)
;; sonst, beim letzten Zeichen in der Zeile...
(if (= (substr str pt_rsp 1) " ") ; Falls es ein Blank ist ...
(pt_bul) ; die Zeilen darunter unmittelbar anh„ngen.
;; sonst das aktuelle Zeichen durch ein Leerzeichen ersetzen.
(setq str (strcat (pt_sjk 1 (1- pt_rsp)) " "))
)
)
)
((= dir "UP")
(if (and TX:LST (> pt_cl 1)) ; pt_cl darf nicht kleiner als 1 werden.
(progn
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
(setq pt_cl (1- pt_cl)
ent (entget(nth (1- pt_cl) TX:LST))
str (cdr(assoc 1 ent))
strlst (pt_psl str) ; String in Liste zergliedern
)
(terpri)
)
)
)
((= dir "DOWN")
(if (and TX:LST (< pt_cl (length TX:LST)))
(progn
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
(setq pt_cl (1+ pt_cl)
ent (entget(nth (1- pt_cl) TX:LST))
str (cdr(assoc 1 ent))
strlst (pt_psl str) ; String in Liste zergliedern
)
(terpri)
)
)
)
)
(princ "\rText: ")
(princ str)
pt_rsp
)
;;;
;;; Bei L”schen am Ende einer Textzeile die darunterliegenden Zeilen unmittel-
;;; bar anh„ngen.
;;;
;;; pt_bul == PText_Bring_Up_Lines
;;;
(defun pt_bul ()
(if (< pt_cl (length TX:LST))
(progn
(setq str (strcat
(substr str 1 (- pt_rsp 1))
(cdr(assoc 1 (entget (nth pt_cl TX:LST))))
)
sset (ssadd)
j pt_cl
)
(entdel (nth pt_cl TX:LST))
(setq TX:LST (pt_sil pt_cl TX:LST))
(while (< j (length TX:LST))
(ssadd (nth j TX:LST) sset)
(setq j (1+ j))
)
(if (> (sslength sset) 0)
(command "schieben"
sset
""
pt_spt
(polar pt_spt (+ pt_ra (/ pi 2)) pt_ils)
)
)
)
)
;; andernfalls nichts tun.
)
;;;
;;; Begriff aus der Liste der ENAMEs in TX:LST streichen.
;;;
;;; pt_sil == PText_Strip_Item_from_List
;;;
(defun pt_sil (temp lst / j k tmplst)
(setq j 0
k (length lst)
)
(while (< j k)
(if (= j (1- temp))
(setq j (1+ j)) ; Beginn berspringen...
;; ansonsten
(setq tmplst (if tmplst
(append tmplst (list (nth j lst)))
(list (nth j lst))
)
j (1+ j)
)
)
)
tmplst
)
;;;
;;; Objektnamen in die Liste der ENAMEs in TX:LST aufnehmen.
;;; TX:LST muá mindestens einen Begriff beinhalten.
;;;
;;; pt_ael == PText_Add_Ename_to_List
;;;
(defun pt_ael (ename temp lst / j k tmplst)
(setq j 0
k (length lst)
)
(while (< j k)
(setq tmplst (if tmplst
(append tmplst (list (nth j lst)))
(list (nth j lst))
)
j (1+ j)
)
(if (= j (1- temp))
(setq tmplst (append tmplst (list ename)))
)
)
tmplst
)
;;;
;;; Begriff (ename) an Liste (lst) anfgen.
;;;
;;; pt_ail == PText_Add_Item_to_List
;;;
(defun pt_ail (ename temp lst / j k tmplst)
(setq j 0
k (length lst)
)
(while (< j k)
(if (= j temp)
(setq tmplst (if tmplst
(append tmplst (list ename))
(list ename)
)
temp nil
)
)
(setq tmplst (if tmplst
(append tmplst (list (nth j lst)))
(list (nth j lst))
)
j (1+ j)
)
)
(if temp (if tmplst
(append tmplst (list ename))
(list ename)
)
)
tmplst
)
;;;
;;; Ein Zeichen and String anfgen
;;;
;;; pt_ats == PText_Add_char_To_String
;;;
(defun pt_ats (char appnd)
;; Falls šberschreiben...
(if (null insert)
;; Den Begriff "pt_rsp" aus Liste "strlst" streichen.
(if (< pt_rsp pt_msp) (setq strlst (pt_sil pt_rsp strlst)))
)
;; Begriff (chr char) an Liste "strlst" anfgen.
(setq strlst (pt_ail (chr char) (if appnd pt_rsp (1- pt_rsp)) strlst))
(setq str (pt_sjk 1 (length strlst)))
(princ "\rText: ")
(princ str)
(1+ pt_rsp)
)
;;;
;;; Neue Textzeile verarbeiten.
;;;
;;; pt_pnl == PText_Process_NewLine
;;;
(defun pt_pnl (/ sset j)
(if ent ; An diesem Punkt (!) sollte immer ein Objekt existieren...
(progn
;; Den korrekten "Startpunkt" fr den aktuellen Typ des Textobjektes
;; ermitteln.
;; Auch verschiedene Textausrichtungen sollten korrekt bearbeitet werden
(setq pt_spt (cdr(assoc (if (or (= grp_72 2) ; Ausrichtung nach RECHTS
(= grp_72 1) ; Ausrichtung nach LINKS
) 11 10) ent))
pt_spt (polar pt_spt (- pt_ra (/ pi 2)) pt_ils)
)
(if (= grp_72 5) ; falls Text EINGEPASST
(setq pt_rpt (cdr(assoc 11 ent))
pt_rpt (polar pt_rpt (- pt_ra (/ pi 2)) pt_ils)
)
)
(setq ent (subst (cons 1 (substr str 1 (1- pt_rsp))) (assoc 1 ent) ent)
str (substr str pt_rsp) ; Ausgleich eines Strings.
)
(if (= (cdr(assoc 1 ent)) "")
(setq ent (subst (cons 1 " ") (assoc 1 ent) ent))
)
(entmod ent)
;; Leerzeile am Ende eines Absatzes...
(if (and (= pt_cl (length tx:lst)) (= str " "))
(setq str "") ; Routine beenden.
;; ansonsten...
(progn
(setq sl (strlen str)
pt_tsp (pt_cll sl nil)
pt_str (pt_uls str pt_tsp)
sset (ssadd)
j pt_cl
)
(while (< j (length TX:LST))
(ssadd (nth j TX:LST) sset)
(setq j (1+ j))
)
(if (> (sslength sset) 0)
(command "schieben"
sset
""
pt_spt
(polar pt_spt (- pt_ra (/ pi 2)) pt_ils)
)
)
)
)
(setq ent nil)
(setq sl 0)
)
(progn
(princ "\nKonnte neue Zeile nicht erzeugen. ")
(exit)
)
)
)
;;;
;;; Zeile verarbeiten
;;;
;;; pt_pl == PText_Process_Line
;;;
(defun pt_pl ()
(if ent ; Textstring modifizieren
(entmod (setq ent (subst (cons 1 pt_str) (assoc 1 ent) ent)))
;; ansonsten
(progn
(dr_txt pt_str) ; Text verschieben
(setq TX:LST (if TX:LST
(pt_ael (cdr(assoc -1 ent)) pt_cl TX:LST)
(list (cdr(assoc -1 ent)))
)
)
)
)
)
;;;
;;; Maximal zul„ssige Stringposition einer vorgegebenen Zeile mit Hilfe des
;;; Inhalts der Variablen "str" ermitteln. Greift auf (pt_gll) zu.
;;;
;;; pt_gmp == PText_Get_Maximum_string_Position
;;;
(defun pt_gmp (/ temp)
;; Angenommene Anzahl von Zeichen, die in einer Zeile zul„ssig ist.
;; šberprfen anhand der momentanen Zeilenl„nge mit tats„chlichen Zeichen
;; durch Hinzufgen von Zeichen bis entweder das Ende des Strings oder
;; die maximale Zeilenl„nge erreicht ist. Dann die einzelnen Zeichen
;; abziehen bis entweder ein Blank, ein Bindestrich oder der Anfang des
;; Strings erreicht ist. Sollte der Anfang des Strings erreicht sein, wird
;; der String vorw„rts bis zum Ende des Wortes weiterverfolgt. Konnte das
;; Ende des Wortes nicht ermittelt werden, dann die 1 setzen, ansonsten die
;; Position des Zeilenumbruchs festhalten.
(setq temp (round (/ pt_mll (* 0.8 pt_twf pt_th))))
(while (and (< temp pt_rsp) (< (pt_gll temp) pt_mll))
(setq temp (1+ temp))
)
(while (> (pt_gll temp) pt_mll)
(setq temp (1- temp))
)
(while (and (> temp 1)
(/= (nth (1- temp) strlst) " ") ; Zeile zurckverfolgen bis Blank
(/= (nth (1- temp) strlst) "-") ; oder Bindestrich gefunden ist..
)
(setq temp (1- temp))
)
(if (= temp 1)
(progn
(setq temp (round (/ pt_mll (* 0.8 pt_twf pt_th))))
(while (and (< temp pt_rsp)
(/= (nth (1- temp) strlst) " ") ; Zurckverfolgen bis Blank
(/= (nth (1- temp) strlst) "-") ; oder Bindestrich gefunden..
)
(setq temp (1+ temp))
)
)
)
(if (= temp pt_rsp)
1
temp
)
)
;;;
;;; Zeile am Ende des vorherigen Wortes umbrechen, falls eines vorhanden ist.
;;; Andernfalls, wenn die Zeile zu kurz und/oder das Wort so lang ist, daá
;;; es die volle Zeilenl„nge aussch”pft, wird das Wort verl„ngert.
;;;
;;; pt_waw == PText_Wrap_At_Word
;;;
(defun pt_waw (/ temp)
(setq temp (pt_gmp)) ; Maximale Stringposition ermitteln.
(if (= grp_72 5) ; Text einpassen..
;; Test durchfhren, ob letztes Viertel des Wortes erfaát,
;; wenn ja, das ganze Wort in die Zeile einpassen.
(progn
(setq line_l (* 0.9
pt_twf
pt_th
(- pt_rsp (* (- pt_rsp temp) 0.25)))
)
)
;; Andernfalls einen Dummy in entsprechender GrӇe einrichten, um den
;; n„chsten Test durchfhren zu k”nnen.
(setq line_l (* 2 line_l))
)
(pt_cll temp T) ; Visuelle Stringposition ausgeben.
)
;;;
;;; Wortumbruch durchfhren.
;;;
;;; pt_pww == PText_Process_Word_Wrap
;;;
(defun pt_pww (loc / sset j)
;; Nicht am Anfang einer Zeile und falls die L„nge der Zeile die maximal
;; vorgegebene GrӇe bersteigt.
(if (and (> loc 1) (> line_l pt_mll))
;; Textzeile umbrechen...
(progn
(pt_pee) ; Vorhandenes Objekt verarbeiten
(pt_mne) ; Hier neue Textzeile einrichten
(pt_fww)
)
;; Textzeile umbrechen...
(progn
;; Den auf Bildschirm auszugebenden String ber (entmod) bereitstellen.
(setq pt_str (pt_uls str pt_rsp))
(setq ent (subst (cons 1 pt_str) (assoc 1 ent) ent))
(entmod ent)
)
)
)
;;;
;;; Den vorhandenen String verarbeiten, in letztendliches Format berfhren.
;;;
;;; pt_pee == PText_Process_Existing_Entity
;;;
(defun pt_pee ()
(repeat (- (pt_cll pt_msp nil) loc) (princ (chr P_BACK))
(princ (chr P_SPCE))
(princ (chr P_BACK))
)
(princ "\rText: ")
;; Anh„ngende Leerzeichen entfernen.
(if (= (nth (1- loc) strlst) " ") (setq loc (1- loc)))
(setq ent (subst
(cons 1 (princ (pt_sjk 1 loc))) ; String ausgeben
(assoc 1 ent)
ent
)
pt_cl (1+ pt_cl)
pt_spt (cdr(assoc (if (or (= grp_72 2)
(= grp_72 1)) 11 10) ent))
str (pt_sjk (+ loc 2) (length strlst))
strlst (pt_psl str) ; String in Liste zergliedern
pt_msp (pt_cll (length strlst) T) ; Zeilenl„nge berprfen
pt_vsp (pt_cll (- pt_rsp loc) T)
pt_rsp (pt_cll pt_vsp nil) ; Position/GrӇe der Zeichen erfassen
)
(if (< pt_vsp 1) (setq pt_vsp 1))
(entmod ent)
)
;;;
;;; Nach Wortumbruch ein neues Objekt erstellen.
;;;
;;; pt_mne == PText_Make_New_Entity
;;;
(defun pt_mne ()
(princ "\nText: ")
(princ str)
;; den auf dem Bildschirm auszugebenden String ber (entmod) bereitstellen.
(setq pt_str (pt_uls str pt_rsp))
(if (<= pt_cl (length TX:LST))
(progn
(setq ent (entget(nth (1- pt_cl) TX:LST))
pt_spt (cdr(assoc (if (or (= grp_72 2)
(= grp_72 1)) 11 10) ent))
)
(if (= grp_72 5) ; falls Text EINPASSEN
(setq pt_rpt (cdr(assoc 11 ent))
pt_rpt (polar pt_rpt (- pt_ra (/ pi 2)) pt_ils)
)
)
)
;; andernfalls
;;(setq ent nil)
(princ)
)
(setq pt_spt (polar pt_spt (- pt_ra (/ pi 2)) pt_ils))
(dr_txt pt_str) ; Textstring verschieben
(setq TX:LST (if TX:LST
(pt_ael (cdr(assoc -1 ent)) pt_cl TX:LST)
(list (cdr(assoc -1 ent)))
)
)
)
;;;
;;; Wortumbruch fertig bearbeiten; N„chstes Zeichen vorbereiten.
;;; Eventuell nachfolgende Objekte eine Einheit nach unten schieben.
;;;
;;; pt_fww == PText_Finish_Word_wrap
;;;
(defun pt_fww ()
(setq sset (ssadd)
j pt_cl
)
(while (< j (length TX:LST))
(ssadd (nth j TX:LST) sset)
(setq j (1+ j))
)
(if (> (sslength sset) 0)
(command "schieben"
sset
""
pt_spt
(polar pt_spt (- pt_ra (/ pi 2)) pt_ils)
)
)
)
;;;
;;; Eine Zeile l”schen und zur vorhergehenden springen.
;;;
;;; pt_dal == PText_Delete_A_Line
;;;
(defun pt_dal (temp / )
;; Letzen ENAMEn entfernen, falls an letzter Position des Strings; Steuer-
;; zeichen allerdings nicht mitgerechnet. Beide sollten auf 1 stehen.
(if (= pt_vsp pt_msp)
(if temp
(progn
(if ent (entdel (cdr(assoc -1 ent))))
(setq TX:LST (pt_sil pt_cl TX:LST))
(repeat (1+ (strlen str))
(princ (chr P_BACK))
(princ (chr P_SPCE))
(princ (chr P_BACK))
)
(princ "*Gel”scht*")
(princ "\nText: ")
)
(progn
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
(setq str "")
)
)
(entmod (subst (cons 1 str) (assoc 1 ent) ent))
)
(setq pt_cl (1- pt_cl)
ent (if (and (> pt_cl 0) (> (length TX:LST) 0))
(entget (nth (1- pt_cl) TX:LST))
nil
)
)
(if ent
(progn
(if temp
(progn
(pt_bul) ; Nachfolgende Zeilen nachrcken.
(setq str (strcat (cdr(assoc 1 ent)) str))
)
(setq str (cdr(assoc 1 ent)))
)
(setq strlst (pt_psl str)
pt_msp (pt_cll (length strlst) T)
pt_vsp pt_msp
pt_spt (polar pt_spt (+ pt_ra (/ pi 2)) pt_ils)
)
(princ str)
(if (= grp_72 5)
(setq pt_rpt (polar pt_rpt (+ pt_ra (/ pi 2)) pt_ils))
)
)
(progn
(setq TX:LST nil
ent nil
)
)
)
)
;;;
;;; Alle Textausdrcke verschieben
;;;
;;;
(defun dr_txt (str / j)
(setq j (* pt_ra (/ 180 pi))) ; Drehwinkel in Dezimalgrad.
(cond
((= grp_72 0) (command "text" pt_spt pt_th j str))
((= grp_72 1) (command "text" "z" pt_spt pt_th j str))
((= grp_72 2) (command "text" "r" pt_spt pt_th j str))
((= grp_72 5) (command "text" "e" pt_spt pt_rpt pt_th str))
)
(setq ent (entget(entlast)))
(setq pt_spt (cdr(assoc (if (or (= grp_72 2) (= grp_72 1)) 11 10) ent)))
(setq pt_spt (polar pt_spt (- pt_ra (/ pi 2)) pt_ils))
(if (= grp_72 5)
(setq pt_rpt (polar pt_rpt (- pt_ra (/ pi 2)) pt_ils))
)
ent
)
;;;
;;; Auf die n„chste Integerzahl korrekt aufrunden
;;;
;;;
(defun round (num)
(if (>= (- num (fix num)) 0.5)
(fix (1+ num))
(fix num)
)
)
;;; ------------------ Hier abschneiden ----------------------------------
;;;
;;; C: Definitionen.
;;;
(defun c:pt () (vmon)(ptext))
(defun c:ptext () (vmon)(ptext))
(princ "\n\tC:PText geladen. Starten mit PT oder PTEXT.")
(princ)