115 lines
3.4 KiB
Common Lisp
115 lines
3.4 KiB
Common Lisp
; das Hauptprogramm UPDATE
|
|
|
|
(defun C:UPDATE ()
|
|
(LESEN)
|
|
(ATTLISTE)
|
|
(ŽNDERE-NAMEN)
|
|
)
|
|
|
|
; die Prozedur LESEN zum Einlesen der Žnderungen
|
|
|
|
(defun LESEN ()
|
|
(setq datei-inhalt ())
|
|
(setq datei (open "g:\prog\acad\menu1\test.pos" "r"))
|
|
(setq zeile (read-line datei))
|
|
(while zeile
|
|
(setq positi (substr zeile 2 6))
|
|
(setq nummer (substr zeile 8 30))
|
|
(setq zeilen-liste (list positi nummer))
|
|
(setq datei-inhalt (cons zeilen-liste datei-inhalt))
|
|
(setq zeile (read-line datei))
|
|
)
|
|
(close datei)
|
|
)
|
|
|
|
; die Prozedur ATTLISTE findet die Blockeinf�gungen in der Datenbank
|
|
|
|
(defun ATTLISTE ()
|
|
(setq eigenschafts-liste ())
|
|
(setq e (entnext))
|
|
(while e
|
|
(setq typ (cdr (assoc 0 (entget e))))
|
|
(setq blockname (cdr (assoc 2 (entget e))))
|
|
(if
|
|
(and
|
|
(equal typ "INSERT")
|
|
(equal (cdr (assoc 66 (entget e))) 1)
|
|
)
|
|
(EIGENSCHAFTSLISTE-BILDEN e)
|
|
)
|
|
(setq e (entnext e))
|
|
)
|
|
)
|
|
|
|
; die Prozedur EIGENSCHAFTSLISTE-BILDEN ermittelt die wichtigen Daten aus
|
|
; der Datenbank
|
|
|
|
(defun EIGENSCHAFTSLISTE-BILDEN (e)
|
|
(setq db-liste ())
|
|
(while (not
|
|
(equal
|
|
(cdr (assoc 0 (entget e)))
|
|
"SEQEND"))
|
|
(cond
|
|
((cdr (assoc 66 (entget e)))
|
|
(setq db-liste ())
|
|
(setq satz-liste ())
|
|
(setq satz-liste
|
|
(cons (cdr (assoc -1 (entget e))) satz-liste))
|
|
(setq satz-liste
|
|
(cons (cdr (assoc 2 (entget e))) satz-liste))
|
|
(setq db-liste (cons satz-liste db-liste))
|
|
)
|
|
((equal (cdr (assoc 0 (entget e))) "ATTRIB")
|
|
(setq satz-liste ())
|
|
(setq satz-liste
|
|
(cons (cdr (assoc 1 (entget e))) satz-liste))
|
|
(setq satz-liste
|
|
(cons (cdr (assoc 2 (entget e))) satz-liste))
|
|
(setq db-liste (cons satz-liste db-liste))
|
|
(if
|
|
(equal (cdr (assoc 2 (entget e))) "POSITION")
|
|
(setq schl�ssel (cdr (assoc 1 (entget e))))
|
|
)
|
|
)
|
|
)
|
|
(setq e (entnext e))
|
|
)
|
|
(setq db-liste (reverse db-liste))
|
|
(setq db-liste (cons schl�ssel db-liste))
|
|
(setq eigenschafts-liste
|
|
(cons db-liste eigenschafts-liste))
|
|
)
|
|
|
|
; die Prozedur ŽNDERE-NAMEN f�hrt die Žnderung aus
|
|
|
|
(defun ŽNDERE-NAMEN ()
|
|
(setq eingabe-liste datei-inhalt)
|
|
(while eingabe-liste
|
|
(setq vergleichs-liste (car eingabe-liste))
|
|
(setq eingabe-liste (cdr eingabe-liste))
|
|
(setq positi (car vergleichs-liste))
|
|
(setq name (last vergleichs-liste))
|
|
(cond
|
|
((assoc positi eigenschafts-liste)
|
|
(setq attribut-liste (assoc positi eigenschafts-liste))
|
|
(setq e-zu-„ndern (last (cadr attribut-liste)))
|
|
(while (not
|
|
(equal (cdr (assoc 0 (entget e-zu-„ndern))) "SEQEND"))
|
|
(setq attribut-bezeichnung (cdr (assoc 2 (entget e-zu-„ndern))))
|
|
(cond
|
|
((equal attribut-bezeichnung "POSITION")
|
|
(entmod (subst (cons '1 name) (assoc 1 (entget e-zu-„ndern))
|
|
(entget e-zu-„ndern)))
|
|
(entupd e-zu-„ndern)
|
|
)
|
|
)
|
|
(setq e-zu-„ndern (entnext e-zu-„ndern))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
|