67 lines
2.1 KiB
Common Lisp
67 lines
2.1 KiB
Common Lisp
;-------------------------------------------------------------
|
|
;Positionieren AW 1.5.93 - abgeleitet von UPDATE
|
|
; aus TEWI - AutoCAD und Datenbanken
|
|
;die Prozedur LESEN zum Einlesen der Žnderungen
|
|
;--------------------------------------------------------------
|
|
|
|
(defun c:po ()
|
|
(Setvar "Cmdecho" 0)
|
|
(If (= EFNAM nil) (Setq EFNAM ""))
|
|
(Setq X (Getstring (Strcat "\nName der ASCII-Datei: <"
|
|
EFNAM ">: ")))
|
|
(If (/= X "") (Setq EFNAM X))
|
|
(Setq EFPNT (Open EFNAM "r"))
|
|
(If
|
|
(= EFPNT nil)
|
|
(Princ (Strcat "\n"(Chr 34) EFNAM (Chr 34)
|
|
": Datei kann nicht ge”ffnet werden!"))
|
|
(Progn
|
|
(Setq CRNTL (Read-line EFPNT))
|
|
(While CRNTL
|
|
(setq POSITI (substr CRNTL 1 6))
|
|
(setq ADRESSE (substr CRNTL 8 30))
|
|
(setq NUMMER (handent ADRESSE))
|
|
(setq OBJEKT (entnext))
|
|
(while OBJEKT
|
|
(setq ADRESSE1 (cdr (assoc 5 (entget OBJEKT))))
|
|
(princ (strcat ADRESSE ADRESSE1 "\n"))
|
|
(if (not (equal ADRESSE ADRESSE1)))
|
|
(progn
|
|
(setq OBJEKT (entnext OBJEKT))
|
|
)
|
|
(progn
|
|
(princ "Ich rufe aendere ...")
|
|
(aendere objekt)
|
|
)
|
|
)
|
|
)
|
|
(Setq CRNTL (Read-line EFPNT))
|
|
)
|
|
(Close EFPNT)
|
|
)
|
|
)
|
|
(Princ)
|
|
)
|
|
|
|
|
|
(defun aendere (objekt)
|
|
(while (not (equal (cdr (assoc 0 (entget objekt))) "SEQEND"))
|
|
(setq typ (cdr (assoc 0 (entget objekt))))
|
|
(if
|
|
(equal typ "ATTRIB")
|
|
(progn
|
|
(setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt))))
|
|
(setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt))))
|
|
(if (equal ATTRIBUT-BEZEICHNUNG "POSITION")
|
|
(progn
|
|
(princ "Ich will „ndern...")
|
|
(entmod (subst (cons 1 POSITI) (assoc 1 (entget objekt))
|
|
(entget objekt)))
|
|
(princ "Ich HABE ge„ndert !")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|