731 lines
21 KiB
Common Lisp
731 lines
21 KiB
Common Lisp
;;; CHTEXT.lsp
|
|
;;; Copyright (C) 1990 by Autodesk, Inc.
|
|
;;;
|
|
;;; von Jan S. Yoder 09. M„rz 1990
|
|
;;;
|
|
;;; Version 0.8
|
|
;;;
|
|
;;;----------------------------------------------------------------------------;
|
|
;;; BESCHREIBUNG
|
|
;;; Das ist ein "Textprozessor", welcher einzeln oder global
|
|
;;; die Eigenschaften H”he, Ausrichtung, Position, Drehwinkel,
|
|
;;; Textstil, Text und Textweite gew„hlter Texte „ndern kann.
|
|
;;;
|
|
;;; Der Befehl wird mit CHT aufgerufen und der Nutzer wird aufge-
|
|
;;; gefordert, das zu „ndernde Objekt zu w„hlen:
|
|
;;;
|
|
;;; Zu „ndernden Text waehlen.
|
|
;;; Objekt w„hlen:
|
|
;;;
|
|
;;; Wenn nichts gew„hlt wurde wird die Meldung: "FEHLER: Nichts gew„hlt."
|
|
;;; angezeigt und der Befehl beendet. Wenn mehr als 25 Texte gew„hlt wurden,
|
|
;;; wird die folgende Meldung angezeigt, w„hrend die Texte von den "Nicht-
|
|
;;; Textbestandteilen der Zeichnung aussortiert werden.
|
|
;;; Ein Z„hler zeigt die Anzahl bereits gefundener Texte an.
|
|
;;;
|
|
;;; Best„tigen der gewaehlten Elemente -- Bitte warten.
|
|
;;; nnn Textelemente gefunden.
|
|
;;; CHText: H”he/Ausrichtung/Position/Drehwinkel/Stil/Text/Zur�ck/Weite:
|
|
;;;
|
|
;;; Ein typisches Beispiel f�r die Anfragen sehen Sie im folgenden:
|
|
;;;
|
|
;;; Sie haben einen einzelnen Text zum Žndern der Texth”he gew„hlt und
|
|
;;; die Anfragen sehen so aus:
|
|
;;;
|
|
;;; CHText: H”he/Ausrichtung/Position/Drehwinkel/Stil/Text/Zur�ck/Weite:
|
|
;;; Neue Texth”he <0.0875>:
|
|
;;;
|
|
;;; Wenn Sie mehrere Texte zum Žndern der Texth”he gew„hlt haben, sieht
|
|
;;; der Befehlsdialog wie folgt aus:
|
|
;;;
|
|
;;; CHText: H”he/Ausrichtung/Position/Drehwinkel/Stil/Text/Zur�ck/Weite:
|
|
;;; Neu Texth”he fuer alle Texte oder Liste/Einzeln:
|
|
;;;
|
|
;;; "L" als Antwort f�hrt zur Anzeige der im Text genutzten Werte.
|
|
;;;
|
|
;;; H”he -- Min: 0.05000000 Max: 0.10000000 Mittel: 0.08392857
|
|
;;;
|
|
;;; "E" f�hrt Sie in eine Schleife, welche schrittweise alle gew„hlten
|
|
;;; Texte mit der Abfrage wie bei einer einzelnen Textwahl zum Žndern
|
|
;;; Ihnen anbietet.
|
|
;;;
|
|
;;; Die Eingabe von RETURN f�hrt Sie zum "Command:"-Prompt zur�ck.
|
|
;;; Bei Wahl einer der Optionen, k”nnen Sie die entsprechenden Eigen-
|
|
;;; schaften „ndern.
|
|
;;;
|
|
;;; Alle Textausrichtungsoptionen der Release 11 werden unterst�tzt.
|
|
;;; Dazu muss die Systemvariable "DIMCLRD" gesetzt sein.
|
|
;;; Ist das nicht der Fall, werden die Optionen der Release 10 unter-
|
|
;;; st�tzt.
|
|
;;;
|
|
|
|
; Hauptprogramm -- Keine Argumente
|
|
|
|
(defun chtxt (/ sset opt ssl nsset temp unctr ; lokale Variablen
|
|
sslen style hgt rot txt ent cht_oc
|
|
loc loc1 justp justq orthom )
|
|
|
|
(setq pt_ver "1.00") ; Versionsanzeige, bei Programm„nderungen
|
|
;; ; bitte anpassen
|
|
;; Interne Fehlerroutine
|
|
;;
|
|
(defun cht_er (s) ; Wenn ein Fehler (z.B. CTRL-C) w„hrend
|
|
; der Befehlausf�hrung auftritt...
|
|
(if (/= s "Funktion abgebrochen")
|
|
(if (= s "quit / exit abort")
|
|
(princ)
|
|
(princ (strcat "\nFehler: " s))
|
|
)
|
|
)
|
|
(command)
|
|
(eval(read U:E))
|
|
(if cht_oe ; Falls eine alte Fehlerroutine existiert
|
|
(setq *error* cht_oe) ; wird diese wiederhergestellt
|
|
)
|
|
(if cht_oc (setvar "cmdecho" cht_oc)) ; Echobefehl wieder herstellen
|
|
(if cht_ot (setvar "texteval" cht_ot))
|
|
(if cht_oh (setvar "highlight" cht_oh))
|
|
(princ)
|
|
)
|
|
;;
|
|
;; Kern der Funktion
|
|
;;
|
|
(if *error* ; Neue Fehlerroutine setzen
|
|
(setq cht_oe *error* *error* cht_er)
|
|
(setq *error* cht_er)
|
|
)
|
|
|
|
;; Setzen der ZURšCK Gruppen mittels (eval(read U:G)) oder (eval(read U:E))
|
|
(setq U:G "(command \"ZURšCK\" \"gruppe\")"
|
|
U:E "(command \"ZURšCK\" \"ende\")"
|
|
)
|
|
|
|
(setq cht_oc (getvar "cmdecho"))
|
|
(setq cht_oh (getvar "highlight"))
|
|
(setvar "cmdecho" 0)
|
|
|
|
(eval(read U:G))
|
|
|
|
(princ (strcat "\nText Žndern, Version " pt_ver
|
|
", (c) 1990 by Autodesk, Inc. "))
|
|
(prompt "\nZu „ndernden Text w„hlen. ")
|
|
(setq sset (ssget))
|
|
(if (null sset)
|
|
(progn
|
|
(princ "\nFEHLER: Nichts gew„hlt.")
|
|
(exit)
|
|
)
|
|
)
|
|
;; šberpr�fen der Elemente
|
|
(cht_ve)
|
|
;; Das ist die Hauptschleife.
|
|
(cht_ol)
|
|
|
|
(if cht_oe (setq *error* cht_oe)) ; Bei Fehlern alte Fehlerroutine
|
|
(eval(read U:E)) ; wieder herstellen
|
|
(if cht_ot (setvar "texteval" cht_ot))
|
|
(if cht_oh (setvar "highlight" cht_oh))
|
|
(if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing
|
|
(princ)
|
|
)
|
|
;;;
|
|
;;; Pr�fen und Aussortieren der Nichttextelemente
|
|
;;;
|
|
(defun cht_ve ()
|
|
(setq ssl (sslength sset)
|
|
nsset (ssadd))
|
|
(if (> ssl 25)
|
|
(princ "\nBest„tigen der gew„hlten Elemente -- Bitte warten. ")
|
|
)
|
|
(while (> ssl 0)
|
|
(setq temp (ssname sset (setq ssl (1- ssl))))
|
|
(if (= (cdr(assoc 0 (entget temp))) "TEXT")
|
|
(ssadd temp nsset)
|
|
)
|
|
)
|
|
(setq ssl (sslength nsset)
|
|
sset nsset
|
|
unctr 0
|
|
)
|
|
(print ssl)
|
|
(princ "Textelemente gefunden. ")
|
|
)
|
|
;;;
|
|
;;; Die Optionsschleife.
|
|
;;;
|
|
(defun cht_ol ()
|
|
(setq opt T)
|
|
(while (and opt (> ssl 0))
|
|
(setq unctr (1+ unctr))
|
|
(command "ZURšCK" "gruppe")
|
|
(initget "Position Ausrichtung Stil H”he Drehwinkel Weite Text Zur�ck")
|
|
(setq opt (getkword
|
|
"\nH”he/Ausrichtung/Position/Drehwinkel/Stil/Text/Zur�ck/Weite: "))
|
|
(if opt
|
|
(cond
|
|
((= opt "Zur�ck")
|
|
(cht_ue) ; Zur�cknehemen des vorherigen Befehls
|
|
)
|
|
((= opt "Position")
|
|
(cht_le) ; Žndern der Position
|
|
)
|
|
((= opt "Ausrichtung")
|
|
(cht_je) ; Žndern der Ausrichtung
|
|
)
|
|
((= opt "Stil") (cht_pe "Stil" "Stilnamen" 7) )
|
|
((= opt "H”he") (cht_pe "H”he" "H”henfaktor" 40) )
|
|
((= opt "Drehwinkel") (cht_pe "Drehwinkel" "Drehwinkel" 50) )
|
|
((= opt "Weite") (cht_pe "Weite" "Weitenfaktor" 41) )
|
|
((= opt "Text")
|
|
(cht_te) ; Žndern des Textes.
|
|
)
|
|
)
|
|
(setq opt nil)
|
|
)
|
|
(command "Zur�ck" "ende")
|
|
)
|
|
)
|
|
;;;
|
|
;;; Einen Eintrag zuruecknehmen
|
|
;;;
|
|
(defun cht_ue ()
|
|
(if (> unctr 1)
|
|
(progn
|
|
(command "Zur�ck" "ende")
|
|
(command "Zur�ck" "2")
|
|
(setq unctr (- unctr 2))
|
|
)
|
|
(progn
|
|
(princ "\nNichts zur�ckgenommen. ")
|
|
(setq unctr (- unctr 1))
|
|
)
|
|
)
|
|
)
|
|
;;;
|
|
;;; Žndern der Position eines Eintrages.
|
|
;;;
|
|
(defun cht_le ()
|
|
(setq sslen (sslength sset)
|
|
style ""
|
|
hgt ""
|
|
rot ""
|
|
txt ""
|
|
)
|
|
(command "Žndern" sset "" "")
|
|
(while (> sslen 0)
|
|
(setq ent (entget(ssname sset (setq sslen (1- sslen))))
|
|
opt (list (cadr (assoc 11 ent))
|
|
(caddr (assoc 11 ent))
|
|
(cadddr (assoc 11 ent)))
|
|
)
|
|
(prompt "\nGeben Sie den neuen Textstandort ein: ")
|
|
(command pause)
|
|
(if (null loc)
|
|
(setq loc opt)
|
|
)
|
|
(command style hgt rot txt)
|
|
)
|
|
(command)
|
|
)
|
|
;;;
|
|
;;; Die Ausrichtung „ndern.
|
|
;;;
|
|
(defun cht_je ()
|
|
(if (getvar "DIMCLRD")
|
|
(initget (strcat "OLinks OZentriert ORechts "
|
|
"MLinks MZentriert MRechts "
|
|
"ULinks UZentriert URechts "
|
|
"Ausrichten Zentriert Einpassen Links Mitte Rechts ?"))
|
|
(initget "Ausrichten Zentriert Einpassen Links Mitte Rechts ?")
|
|
)
|
|
(setq sslen (sslength sset))
|
|
(setq justp (getkword (strcat "\nAusrichtungspunkt(e) - "
|
|
"Ausrichten/Zentriert/Einpassen/Links/Mitte/Rechts/<?>: ")))
|
|
(cond
|
|
((= justp "Links") (setq justp 0 justq 0) )
|
|
((= justp "Zentriert") (setq justp 1 justq 0) )
|
|
((= justp "Rechts") (setq justp 2 justq 0) )
|
|
((= justp "Ausrichten") (setq justp 3 justq 0) )
|
|
((= justp "Einpassen") (setq justp 5 justq 0) )
|
|
((= justp "OLinks") (setq justp 0 justq 3) )
|
|
((= justp "OZentriert") (setq justp 1 justq 3) )
|
|
((= justp "ORechts") (setq justp 2 justq 3) )
|
|
((= justp "MLinks") (setq justp 0 justq 2) )
|
|
((= justp "Mitte") (setq justp 1 justq 2) )
|
|
((= justp "MZentriert") (setq justp 1 justq 2) )
|
|
((= justp "MRechts") (setq justp 2 justq 2) )
|
|
((= justp "ULinks") (setq justp 0 justq 1) )
|
|
((= justp "UZentriert") (setq justp 1 justq 1) )
|
|
((= justp "URechts") (setq justp 2 justq 1) )
|
|
((= justp "?") (setq justp nil) )
|
|
(T (setq justp nil) )
|
|
)
|
|
(if justp
|
|
(justpt) ; Ausf�hrung...
|
|
(justpn) ; Optionen auflisten
|
|
)
|
|
(command)
|
|
)
|
|
;;;
|
|
;;; Ausrichtungspunkte f�r "Ausrichten" und "Einpassen"
|
|
;;;
|
|
(defun justpt ()
|
|
(while (> sslen 0)
|
|
(setq ent (entget(ssname sset (setq sslen (1- sslen))))
|
|
ent (subst (cons 72 justp) (assoc 72 ent) ent)
|
|
opt (trans (list (cadr (assoc 11 ent))
|
|
(caddr (assoc 11 ent))
|
|
(cadddr (assoc 11 ent)))
|
|
(cdr(assoc -1 ent)) ; from ECS
|
|
1) ; to current UCS
|
|
)
|
|
(if (getvar "DIMCLRD")
|
|
(setq ent (subst (cons 73 justq) (assoc 73 ent) ent))
|
|
)
|
|
(cond
|
|
((or (= justp 3) (= justp 5))
|
|
(prompt "\nGeben Sie die neuen Textausrichtungspunkte ein: ")
|
|
(if (= (setq orthom (getvar "orthomode")) 1)
|
|
(setvar "orthomode" 0)
|
|
)
|
|
(redraw (cdr(assoc -1 ent)) 3)
|
|
(initget 1)
|
|
(setq loc (getpoint))
|
|
(initget 1)
|
|
(setq loc1 (getpoint loc))
|
|
(redraw (cdr(assoc -1 ent)) 1)
|
|
(setvar "orthomode" orthom)
|
|
(setq ent (subst (cons 10 loc) (assoc 10 ent) ent))
|
|
(setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))
|
|
)
|
|
((/= justp 0)
|
|
(redraw (cdr(assoc -1 ent)) 3)
|
|
(prompt "\nGeben Sie den neuen Textstandort ein: ")
|
|
(if (= (setq orthom (getvar "orthomode")) 1)
|
|
(setvar "orthomode" 0)
|
|
)
|
|
(setq loc (getpoint opt))
|
|
(setvar "orthomode" orthom)
|
|
(redraw (cdr(assoc -1 ent)) 1)
|
|
(if (null loc)
|
|
(setq loc opt)
|
|
(setq loc (trans loc 1 (cdr(assoc -1 ent))))
|
|
)
|
|
(setq ent (subst (cons 11 loc) (assoc 11 ent) ent))
|
|
)
|
|
)
|
|
(entmod ent)
|
|
)
|
|
)
|
|
;;;
|
|
;;; Optionen listen
|
|
;;;
|
|
(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 zum Zeichnungseditor zur�ckzukehren. ")
|
|
(grread)
|
|
(princ "\r ")
|
|
(graphscr)
|
|
)
|
|
;;;
|
|
;;; Text „ndern
|
|
;;;
|
|
(defun cht_te ()
|
|
(setq sslen (sslength sset))
|
|
(initget "Global Einzeln Austauschen")
|
|
(setq ans (getkword "\nText editieren. Einzeln/Austauschen/<Global>:"))
|
|
(setvar "texteval" 1)
|
|
(cond
|
|
((= ans "Einzeln")
|
|
(if (= (getvar "popups") 1)
|
|
(progn
|
|
(initget "Ja Nein")
|
|
(setq ans (getkword "\nText im Dialog editieren? <Ja>:"))
|
|
)
|
|
(setq ans "Nein")
|
|
)
|
|
|
|
(while (> sslen 0)
|
|
(redraw (setq ss (ssname sset (setq sslen (1- sslen)))) 3)
|
|
(setq ss (ssadd))
|
|
(ssadd (ssname sset sslen) ss)
|
|
(if (= ans "Nein")
|
|
(chgtext ss)
|
|
(command "ddedit" ss "")
|
|
)
|
|
(redraw ss 1)
|
|
)
|
|
)
|
|
((= ans "Austauschen")
|
|
(while (> sslen 0)
|
|
(setq ent (entget(ssname sset (setq sslen (1- sslen)))))
|
|
(redraw (cdr(assoc -1 ent)) 3)
|
|
(prompt (strcat "\nAlter Text: " (cdr(assoc 1 ent))))
|
|
(setq nt (getstring T "\nNeuer Text: "))
|
|
(redraw (cdr(assoc -1 ent)) 1)
|
|
(if (> (strlen nt) 0)
|
|
(entmod (subst (cons 1 nt) (assoc 1 ent) ent))
|
|
)
|
|
)
|
|
)
|
|
(T
|
|
(chgtext sset) ; Alle aendern
|
|
)
|
|
)
|
|
(setvar "texteval" cht_ot)
|
|
)
|
|
;;;
|
|
;;; Der alte CHGTEXT Befehl - das Rudiment eines Texteditors
|
|
;;;
|
|
;;;
|
|
(defun C:CHGTEXT () (chgtext nil))
|
|
|
|
(defun chgtext (objs / last_o tot_o ent o_str n_str st s_temp
|
|
n_slen o_slen si chf chm cont ans)
|
|
(if (null objs)
|
|
(setq objs (ssget)) ; Objektwahl falls das Programm allein
|
|
) ; genutzt wird
|
|
(setq chm 0)
|
|
(if objs
|
|
(progn ; Falls etwas gewaehlt wurde
|
|
(if (= (type objs) 'ENAME)
|
|
(progn
|
|
(setq ent (entget objs))
|
|
(princ (strcat "\nExistierender String: " (cdr (assoc 1 ent))))
|
|
)
|
|
(if (= (sslength objs) 1)
|
|
(progn
|
|
(setq ent (entget (ssname objs 0)))
|
|
(princ (strcat "\nExistierender String : " (cdr (assoc 1 ent))))
|
|
)
|
|
)
|
|
)
|
|
(setq o_str (getstring "\nZu ersetzender String: " t))
|
|
(setq o_slen (strlen o_str))
|
|
(if (/= o_slen 0)
|
|
(progn
|
|
(setq n_str (getstring "\nNeuer String : " t))
|
|
(setq n_slen (strlen n_str))
|
|
(setq last_o 0
|
|
tot_o (if (= (type objs) 'ENAME)
|
|
1
|
|
(sslength objs)
|
|
)
|
|
)
|
|
(while (< last_o tot_o) ; F�r jedes gew„hlte Objekt
|
|
(if (= "TEXT" ; Suche nach Textelementen (group 0)
|
|
(cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
|
|
(progn
|
|
(setq chf nil si 1)
|
|
(setq s_temp (cdr (assoc 1 ent)))
|
|
(while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
|
|
(if (= st o_str)
|
|
(progn
|
|
(setq s_temp (strcat
|
|
(if (> si 1)
|
|
(substr s_temp 1 (1- si))
|
|
""
|
|
)
|
|
n_str
|
|
(substr s_temp (+ si o_slen))
|
|
)
|
|
)
|
|
(setq chf t) ; Alten String gefunden
|
|
(setq si (+ si n_slen))
|
|
)
|
|
(setq si (1+ si))
|
|
)
|
|
)
|
|
(if chf
|
|
(progn ; Alten mit neuen String ersetzen
|
|
; Textelement modifizieren
|
|
(entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
|
|
(setq chm (1+ chm))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(setq last_o (1+ last_o))
|
|
)
|
|
)
|
|
;; dann in die n„chste Zeile gehen
|
|
)
|
|
)
|
|
)
|
|
(if (/= (type objs) 'ENAME)
|
|
(if (/= (sslength objs) 1) ; g„nderte Zeile anzeigen
|
|
(princ (strcat "Ge„nderte "
|
|
(rtos chm 2 0)
|
|
" Textzeilen"
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(terpri)
|
|
)
|
|
;;;
|
|
;;; Huptprozedur f�r Textmanipulation
|
|
;;; ARGUMENTE:
|
|
;;; typ -- Typ der durchzuf�hrenden Operation
|
|
;;; prmpt -- Teilstring der Standardanfrage
|
|
;;; fld -- Assoziationslistennummer, welche ge„ndert wird
|
|
;;; GLOBALE VARIABLEN:
|
|
;;; sset -- Auswahlsatz der Textelemente
|
|
;;;
|
|
(defun cht_pe (typ prmpt fld / temp ow nw ent tw sty w hw lw
|
|
sslen n sn ssl)
|
|
(if (= (sslength sset) 1) ; Spezialfall - nur ein Element
|
|
; wurde gew„hlt
|
|
;; Ein-Element-Prozess
|
|
(cht_p1)
|
|
;; sonst
|
|
(progn
|
|
;; Anzeige
|
|
(cht_sp)
|
|
(if (= nw "Liste")
|
|
;; Liste gew�nscht
|
|
(cht_pl)
|
|
(if (= nw "Einzeln")
|
|
;; Einzeldurchfuehrung erw�nscht
|
|
(cht_pi)
|
|
(if (= nw "Wahl")
|
|
;; Wahlweise Durchf�hrung erw�nscht
|
|
(cht_ps)
|
|
;; sonst
|
|
(progn
|
|
(if (= typ "Drehwinkel")
|
|
(setq nw (* (/ nw 180.0) pi))
|
|
)
|
|
(if (= (type nw) 'STR)
|
|
(if (not (tblsearch "style" nw))
|
|
(progn
|
|
(princ (strcat "\nStil " nw " nicht gefunden. "))
|
|
)
|
|
(cht_pa)
|
|
)
|
|
(cht_pa)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
;;;
|
|
;;; Change all of the entities in the selection set.
|
|
;;;
|
|
(defun cht_pa ()
|
|
(setq sslen (sslength sset))
|
|
(setq cht_oh (getvar "texteval"))
|
|
(setvar "highlight" 0)
|
|
(while (> sslen 0)
|
|
(setq temp (ssname sset (setq sslen (1- sslen))))
|
|
(entmod (subst (cons fld nw)
|
|
(assoc fld (setq ent (entget temp)))
|
|
ent
|
|
)
|
|
)
|
|
|
|
)
|
|
(setvar "highlight" cht_oh)
|
|
)
|
|
;;;
|
|
;;; Ein Texteintrag „ndern
|
|
;;;
|
|
(defun cht_p1 ()
|
|
(setq temp (ssname sset 0))
|
|
(setq ow (cdr(assoc fld (entget temp))))
|
|
(if (= opt "Drehwinkel")
|
|
(setq ow (/ (* ow 180.0) pi))
|
|
)
|
|
(redraw (cdr(assoc -1 (entget temp))) 3)
|
|
(initget 0)
|
|
(if (= opt "Stil")
|
|
(setq nw (getstring (strcat "\nDen neuen " prmpt " f�r den Text eingeben. <"
|
|
ow ">: ")))
|
|
(setq nw (getreal (strcat "\nDen neuen " prmpt "f�r den Text eingeben. <"
|
|
(rtos ow 2) ">: ")))
|
|
)
|
|
(if (or (= nw "") (= nw nil))
|
|
(setq nw ow)
|
|
)
|
|
(redraw (cdr(assoc -1 (entget temp))) 1)
|
|
(if (= opt "Drehwinkel")
|
|
(setq nw (* (/ nw 180.0) pi))
|
|
)
|
|
(if (= opt "Stil")
|
|
(if (null (tblsearch "style" nw))
|
|
(princ (strcat "\nStil " nw " nicht gefunden. "))
|
|
|
|
(entmod (subst (cons fld nw)
|
|
(assoc fld (setq ent (entget temp)))
|
|
ent
|
|
)
|
|
)
|
|
)
|
|
(entmod (subst (cons fld nw)
|
|
(assoc fld (setq ent (entget temp)))
|
|
ent
|
|
)
|
|
)
|
|
)
|
|
)
|
|
;;;
|
|
;;; Anfrage
|
|
;;;
|
|
(defun cht_sp ()
|
|
(if (= typ "Stil")
|
|
(progn
|
|
(initget "Einzeln Liste Wahl Enter ")
|
|
(setq nw (getkword (strcat "\n<Enter>, wenn "
|
|
prmpt
|
|
" f�r alle Texte oder Einzeln/Liste/Wahl: ")))
|
|
(if (or (= nw "") (= nw nil) (= nw "Enter"))
|
|
(setq nw (getstring (strcat "\nNeuen "
|
|
prmpt
|
|
" f�r alle Texte eingeben: ")))
|
|
)
|
|
)
|
|
(progn
|
|
(initget "Liste Einzeln" 1)
|
|
(setq nw (getreal (strcat "\nNeuen "
|
|
prmpt
|
|
" f�r alle Texte oder Liste/Einzeln: ")))
|
|
)
|
|
)
|
|
)
|
|
;;;
|
|
;;; Liste ist erw�nscht
|
|
;;;
|
|
(defun cht_pl ()
|
|
(setq unctr (1- unctr))
|
|
(setq sslen (sslength sset))
|
|
(setq tw 0)
|
|
(while (> sslen 0)
|
|
(setq temp (ssname sset (setq sslen (1- sslen))))
|
|
(if (= typ "Stil")
|
|
(progn
|
|
(if (= tw 0)
|
|
(setq tw (list (cdr(assoc fld (entget temp)))))
|
|
(progn
|
|
(setq sty (cdr(assoc fld (entget temp))))
|
|
(if (not (member sty tw))
|
|
(setq tw (append tw (list sty)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(progn
|
|
(setq tw (+ tw (setq w (cdr(assoc fld (entget temp))))))
|
|
(if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
|
|
(if (< hw w) (setq hw w))
|
|
(if (> lw w) (setq lw w))
|
|
)
|
|
)
|
|
)
|
|
(if (= typ "Drehwinkel")
|
|
(setq tw (* (/ tw pi) 180.0)
|
|
lw (* (/ lw pi) 180.0)
|
|
hw (* (/ hw pi) 180.0))
|
|
)
|
|
(if (= typ "Stil")
|
|
(progn
|
|
(princ (strcat "\n"
|
|
typ
|
|
"(e) -- "))
|
|
(princ tw)
|
|
)
|
|
(princ (strcat "\n"
|
|
typ
|
|
" -- Min: "
|
|
(rtos lw 2)
|
|
"\t Max: "
|
|
(rtos hw 2)
|
|
"\t Mittel: "
|
|
(rtos (/ tw (sslength sset)) 2) ))
|
|
)
|
|
)
|
|
;;;
|
|
;;; Einzeln ist der Wunsch
|
|
;;;
|
|
(defun cht_pi ()
|
|
(setq sslen (sslength sset))
|
|
(while (> sslen 0)
|
|
(setq temp (ssname sset (setq sslen (1- sslen))))
|
|
(setq ow (cdr(assoc fld (entget temp))))
|
|
(if (= typ "Drehwinkel")
|
|
(setq ow (/ (* ow 180.0) pi))
|
|
)
|
|
(initget 0)
|
|
(redraw (cdr(assoc -1 (entget temp))) 3)
|
|
(if (= typ "Stil")
|
|
(progn
|
|
(setq nw (getstring (strcat "\nNeuen "
|
|
prmpt
|
|
" f�r Text eingeben. <"
|
|
ow ">: ")))
|
|
)
|
|
(progn
|
|
(setq nw (getreal (strcat "\nNeuen "
|
|
prmpt
|
|
" f�r Text eingeben. <"
|
|
(rtos ow 2) ">: ")))
|
|
)
|
|
)
|
|
(if (or (= nw "") (= nw nil))
|
|
(setq nw ow)
|
|
)
|
|
(if (= typ "Drehwinkel")
|
|
(setq nw (* (/ nw 180.0) pi))
|
|
)
|
|
(entmod (subst (cons fld nw)
|
|
(assoc fld (setq ent (entget temp)))
|
|
ent
|
|
)
|
|
)
|
|
(redraw (cdr(assoc -1 (entget temp))) 1)
|
|
)
|
|
)
|
|
;;;
|
|
;;; Wahloption
|
|
;;;
|
|
(defun cht_ps ()
|
|
(princ "\nWelcher Textstilname wird gesucht? <*>: ")
|
|
(setq sn (strcase (getstring))
|
|
n -1
|
|
sset nsset
|
|
nsset (ssadd)
|
|
ssl (1- (sslength sset))
|
|
)
|
|
(if (or (= sn "*") (null sn) (= sn ""))
|
|
(setq nsset sset sn "*")
|
|
(while (and sn (< n ssl))
|
|
(setq temp (ssname sset (setq n (1+ n))))
|
|
(if (= (cdr(assoc 7 (entget temp))) sn)
|
|
(ssadd temp nsset)
|
|
)
|
|
)
|
|
)
|
|
(setq ssl (sslength nsset))
|
|
(princ ssl)
|
|
(princ " Texteintragungen im Stil ")
|
|
(princ sn)
|
|
(princ "\ngefunden. ")
|
|
|
|
(setq sset nsset)
|
|
)
|
|
;;;
|
|
;;; Die C: Funktionsdefinition.
|
|
;;;
|
|
(defun c:cht () (chtxt))
|
|
(princ "\n\tc:CHText geladen. Starten mit CHT.")
|
|
(princ)
|
|
|