Hallo,
ich habe hier eine lisp mit der ich Text ändern kann.
Wenn ich Text ändere den String vorher nacher
gibt er mir eine Fehlermeldung
Zu ersetzender String: AH
Neuer String : AK
Geänderte 7 Textzeilen
Fehler: Einstellung für AutoCAD-Variable zurückgewiesen: "texteval" nil
mit der Einstellung am Rechner der Variable texteval 0 bzw. 1
kommt beidesmal die Fehlermeldung daran scheint´s nicht zuliegen?
Wer hätte ein Tip für mich.
Vielen Dank im vorraus.
Kerstin
PS:Acad2002 habe ich
(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 "Function cancelled")
(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 AG"))
(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)
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP