66 lines
2.6 KiB
Common Lisp
66 lines
2.6 KiB
Common Lisp
; **********************************************************************
|
|
; CHGTEXT.LSP
|
|
|
|
; Dieses Programm ersetzt jeden vorkommenden "alten String" durch den
|
|
; "neuen String". Zuerst waehlen Sie den zu aendernden Text. Dann
|
|
; werden Sie nach dem "alten String" und nach dem "neuen String"
|
|
; gefragt. Nachdem die Aenderung vollzogen wurde, wird die Anzahl
|
|
; der geaenderten Zeilen angezeigt.
|
|
; **********************************************************************
|
|
|
|
(defun chgterr (s)
|
|
(if (/= s "Function cancelled") ; Wenn ein Fehler (z.B.CTRL-C)
|
|
(princ (strcat "\nError: " s)) ; auftritt, waehrend der Befehl
|
|
; aktiv ist
|
|
)
|
|
(setq p nil) ; Auswahlsatz loeschen
|
|
(setq *error* olderr) ; alte Fehlerroutine holen
|
|
(princ)
|
|
)
|
|
|
|
(defun C:CHGTEXT (/ p l n e os as ns st s nsl osl sl si chf chm olderr)
|
|
(setq olderr *error* ; Initialisieren der Variablen
|
|
*error* chgterr
|
|
chm 0)
|
|
(setq p (ssget)) ; Objekte waehlen
|
|
(if p (progn ; Wenn Objekte gewaehlt...
|
|
(while (= 0 (setq osl (strlen (setq os (getstring t "\nOld text: ")))))
|
|
(princ "No invalid Entry")
|
|
)
|
|
(setq nsl (strlen (setq ns (getstring t "\nNew text: "))))
|
|
(setq l 0 n (sslength p))
|
|
(while (< l n) ; Fuer jedes Objekt ...
|
|
(if (= "TEXT" ; Suchen nach TEXT Elementen(Gruppe 0)
|
|
(cdr (assoc 0 (setq e (entget (ssname p l))))))
|
|
(progn
|
|
(setq chf nil si 1)
|
|
(setq s (cdr (setq as (assoc 1 e))))
|
|
(while (= osl (setq sl (strlen
|
|
(setq st (substr s si osl)))))
|
|
(if (= st os)
|
|
(progn
|
|
(setq s (strcat (substr s 1 (1- si)) ns
|
|
(substr s (+ si osl))))
|
|
(setq chf t) ; Alten String finden
|
|
(setq si (+ si nsl))
|
|
)
|
|
(setq si (1+ si))
|
|
)
|
|
)
|
|
(if chf (progn ; Alten durch neuen String ersetzen
|
|
(setq e (subst (cons 1 s) as e))
|
|
(entmod e) ; TEXT Element modifizieren
|
|
(setq chm (1+ chm))
|
|
))
|
|
)
|
|
)
|
|
(setq l (1+ l))
|
|
)
|
|
))
|
|
(princ chm)
|
|
(princ " Text-String(s) changed ") ; Anzahl der geaenderten Zeilen
|
|
(terpri)
|
|
(setq *error* olderr) ; alte Fehlerfunktion holen
|
|
(princ)
|
|
)
|
|
|