Zitat:
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; CP - Copy Text
;
; Funktion kopiert Textinhalte von Quelltexten nach Zieltexten. Texte
; können dabei vollständig ersetzt, voran- oder nachgestellt werden.
; Ein integrierter Texteditor erlaubt das ändern der Texte während dem
; Kopieren.
; Alle Kopierschritte lassen sich vollständig rückgängig machen.
;
; Aufruf: cp
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; (c) Dipl.-Ing. Volker Kleppel
; http://www.cadwerk.com
; vkleppel@gmx.de
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Version: 1.0 Datum: 20.11.2002
; AutoCAD12 [ ] AutoCAD14 [x] AutoCAD2000(i) [x] AutoCAD2002 [x]
; Freeware [x] Shareware [ ]
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:cp (/ exitflag en ent enX txt txt_alt txt_neu)
;Initialisieren
(setq exitflag nil
cpundo nil
cpModus 1
)
;Quelltext auswählen
(while (= exitflag nil)
(setq enX (nentsel "\nQuelltext wählen"))
(if (= nil enX)
(setq exitflag T)
(progn
(setq en (car enx))
(setq ent (entget en))
(if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "RTEXT" "DIMENSION"))
(setq exitflag T)
)
)
)
)
;NIL ausschließen
(if (= enX nil)
(print)
(progn
;**Hauptprogramm**
(setq exitflag nil)
(setq txt (cdr (assoc 1 ent)))
;Sind MText Steuercodes vorhanden?
(if (wcmatch txt "*\\*")
(princ "\n--> Der Quelltext enthält Formatierungsregeln. Diese können sich beim Kopieren störend auswirken!")
)
;Benutzerausgabe
(princ "\n\nModus: Ersetzen")
;Auswahl steuern
(while (= exitflag nil)
(initget "Präfix Süffix Ersetzen Text Zurück")
(setq
aw
(entsel
"\nZielobjekt wählen [Präfix/Süffix/Ersetzen/Text bearbeiten/Zurück] "
)
)
(if (member aw '("Präfix" "Süffix" "Ersetzen"))
(progn
(setq cpModus (cond
((= aw "Präfix") 3)
((= aw "Süffix") 2)
((= aw "Ersetzen") 1)
(T nil)
)
)
(princ (strcat "\nModus: "
(cond
((= cpmodus 3) "Präfix")
((= cpmodus 2) "Süffix")
((= cpmodus 1) "Ersetzen")
)
)
)
)
(progn
(if (= aw "Zurück")
(if (= cpundo nil)
(princ "\nAlle Änderungen wurden bereits zurückgenommen"
)
(progn
(setq enx (car (reverse cpundo))
en2
(car enx)
txt_neu
(cadr enx)
ent2 (entget en2)
ent2
(subst (cons 1 txt_neu) (assoc 1 ent2) ent2)
)
(entmod ent2)
(entupd en2)
(setq cpundo (reverse (cdr (reverse cpundo))))
)
)
(progn
(if (= aw "Text")
(setq txt (cp_dlgchange txt))
(progn
(if (= aw nil)
(setq exitflag T)
(progn
(setq en2 (car aw))
(setq ent2 (entget en2))
(if (member (cdr (assoc 0 ent2))
'("TEXT" "MTEXT" "RTEXT" "DIMENSION")
)
(progn
(setq txt_alt (cdr (assoc 1 ent2)))
(setq txt_neu (cond
((= cpmodus 3)
(strcat txt txt_alt)
)
((= cpmodus 2)
(strcat txt_alt txt)
)
((= cpmodus 1) txt)
)
)
(setq ent2 (subst (cons 1 txt_neu)
(assoc 1 ent2)
ent2
)
)
(entmod ent2)
(entupd en2)
(setq
cpUndo (append cpUndo
(list (list en2 txt_alt))
)
)
)
(princ "\nGewähltes Objekt ist kein Textobjekt"
)
)
)
)
)
)
)
)
)
)
)
)
)
(print)
)
(defun cp_dlgchange (tmpText / DLGflag tmpText2)
;Dialog laden
(setq dlgid (load_dialog "cp.dcl"))
(if (not (new_dialog "cp_dlg" dlgid))
(progn
(princ
"\nDie Dialogdatei 'cp.dcl' konnte nicht gefunden werden!"
)
(setq tmptext2 tmptext)
)
(progn
;Dialog konfigurieren
(set_tile "dlgText" tmpText)
(action_tile
"accept"
"(setq DLGflag 1 tmpText2 (get_tile \"dlgText\")) (done_dialog)"
)
(action_tile
"cancel"
"(setq DLGflag 0 tmptext2 tmptext) (done_dialog)"
)
(mode_tile "dlgText" 2)
;Dialog anzeigen
(start_dialog)
;Dialog beenden und entladen
(unload_dialog dlgid)
)
) ;Wert zurückgeben
tmptext2
)
Foren auf CAD.de (alle Foren)
| 
. 
"Lisp?!?! Why the Hell did you pick the most arcane, obscure, and hopelessly-rooted-in-the-computer-science-department language in the world for an AutoCAD programming language?" Read the whole story: 
