Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
dxfmakros/Lisp/addattribute.lsp
T

411 lines
15 KiB
Common Lisp
Raw Permalink Blame History

;; ============================================================
;; addattribute.lisp
;; Synchronisiert ATTDEF-Attribute in den ILS-Block-DWGs mit den
;; Werten aus allocations.json.
;;
;; Es wird die allocations.json aus data/ils gelesen
;; (data/ils/allocations.json) und anschliessend werden
;; ausschliesslich die DWGs in genau diesem Verzeichnis bearbeitet.
;;
;; Es gibt zwei Modi (Auswahl beim Befehlsaufruf):
;;
;; MODUS "Ergaenzen" (Vorgabe, bisheriges Verhalten)
;; Ablauf je JSON-Eintrag "Blockname": {"TAG": "Wert", ...}:
;; - <Blockname>.dwg im selben Verzeichnis wie die JSON oeffnen
;; - je Attribut (TAG/Wert):
;; - ATTDEF mit diesem Tag existiert nicht -> neu anlegen,
;; Vorgabewert = JSON-Wert (auch wenn dieser leer ist)
;; - ATTDEF existiert, ist aber leer -> mit JSON-Wert befuellen
;; - ATTDEF existiert und ist bereits befuellt
;; -> NUR ueberschreiben,
;; wenn der JSON-Wert NICHT leer ("") ist. Ein leerer JSON-Wert
;; loescht also nie einen bereits vorhandenen Wert.
;; - ATTDEFs, die in der JSON nicht vorkommen, bleiben unberuehrt.
;;
;; MODUS "Ersetzen" (die JSON ist die alleinige Quelle der Wahrheit)
;; - JSON-Wert wird IMMER gesetzt, auch ein leerer Wert (der Wert des
;; ATTDEF wird dann geleert)
;; - Tags, die in der DWG fehlen, werden neu angelegt
;; - ATTDEFs, deren Tag NICHT in der JSON steht, werden GELOESCHT
;; - vorhandene ATTDEFs werden dabei in-place geaendert, behalten also
;; Position, Texthoehe, Layer und Stil (im Unterschied zu
;; data/omniflo/2D/addattributes.py --replace, das alles neu stapelt)
;;
;; In beiden Modi gilt:
;; - DWG nur dann speichern, wenn sich mindestens ein Attributwert
;; geaendert hat, neu angelegt oder geloescht wurde (bessere
;; Nachverfolgbarkeit im Versionsvergleich). Falls durch dieses
;; Skript geoeffnet, wird die DWG anschliessend wieder geschlossen.
;; War die DWG schon vorher offen, bleibt sie offen.
;;
;; TIPP vor dem ersten "Ersetzen"-Lauf: mit ILS_ATTR_COLLECT
;; (collect_attributes.lsp) den Ist-Zustand als allocations_collected.json
;; schreiben und gegen allocations.json vergleichen - jeder Tag, der nur
;; in der Collected-Datei steht, wird beim Ersetzen geloescht.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../Lisp/addattribute.lsp")
;; ILS_ATTR_SYNC ; fragt den Modus ab (Vorgabe: Ergaenzen)
;; ILS_ATTR_REPLACE ; direkt Modus "Ersetzen" (mit Sicherheitsfrage)
;; ============================================================
(vl-load-com)
;; ssg_core.lsp (JSON-Parser ssg-cfg-parse-nested) sicherstellen,
;; falls das Menue/die Kern-Module noch nicht geladen wurden.
(if (not (car (atoms-family 1 '("SSG-CFG-PARSE-NESTED"))))
(if (getenv "DXFM_LISP")
(load (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_core.lsp"))
)
)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun iad-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
(setq docs (vla-get-Documents (vlax-get-acad-object))
anzahl (vla-get-Count docs)
i 0
treffer nil
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
)
(while (and (< i anzahl) (not treffer))
(setq doc (vla-item docs i))
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
(if (= full dwg-pfad) (setq treffer doc))
(setq i (1+ i))
)
treffer
)
;; ------------------------------------------------------------
;; Statistik-Liste (anz-neu anz-gesetzt anz-geloescht):
;; hat sich ueberhaupt etwas geaendert?
;; (Achtung: eine Liste aus Nullen ist in LISP truthy, daher diese
;; explizite Pruefung statt eines einfachen if.)
;; ------------------------------------------------------------
(defun iad-stat-geaendert (stat)
(and stat (> (apply '+ stat) 0))
)
;; ------------------------------------------------------------
;; Ein einzelnes ATTDEF aktualisieren
;; ersetzen = T -> JSON-Wert immer setzen (auch leer)
;; ersetzen = nil -> ein befuellter Wert bleibt bei leerem JSON-Wert stehen
;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde
;; ------------------------------------------------------------
(defun iad-update-attdef (ent jsonwert ersetzen / ed altwert)
(setq ed (entget ent)
altwert (cdr (assoc 1 ed))
)
(if (null altwert) (setq altwert ""))
(cond
((equal altwert jsonwert)
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert)"))
nil
)
((or ersetzen (= (strlen altwert) 0) (> (strlen jsonwert) 0))
(entmod (subst (cons 1 jsonwert) (assoc 1 ed) ed))
(princ (strcat "\n - " (cdr (assoc 2 ed)) " = '" jsonwert "'"))
t
)
(t
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert, JSON-Wert leer)"))
nil
)
)
)
;; ------------------------------------------------------------
;; Neues (unsichtbares) ATTDEF anlegen
;; ------------------------------------------------------------
(defun iad-create-attdef (tag wert ypos texthoehe layer)
(entmake (list
'(0 . "ATTDEF")
(cons 8 layer)
(cons 10 (list 0.0 ypos 0.0))
(cons 40 texthoehe)
(cons 1 wert)
(cons 3 tag)
(cons 2 tag)
'(70 . 1)
))
(princ (strcat "\n + " tag " = '" wert "' (neu angelegt)"))
)
;; ------------------------------------------------------------
;; Vorhandenes ATTDEF loeschen (nur Modus "Ersetzen")
;; ------------------------------------------------------------
(defun iad-delete-attdef (ent / ed altwert)
(setq ed (entget ent)
altwert (cdr (assoc 1 ed))
)
(if (null altwert) (setq altwert ""))
(princ (strcat "\n x " (cdr (assoc 2 ed)) " = '" altwert "' (geloescht)"))
(entdel ent)
)
;; ------------------------------------------------------------
;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
;; attribs = (("TAG" . "Wert") ...)
;; ersetzen = T -> JSON ist die alleinige Quelle der Wahrheit
;; (Werte immer setzen, ueberzaehlige ATTDEFs loeschen)
;; Rueckgabe: Statistik-Liste (anz-neu anz-gesetzt anz-geloescht)
;; ------------------------------------------------------------
(defun iad-sync-attribs-in-current-doc (attribs ersetzen / texthoehe layer ss anzahl i ent ed
tag wert pt vorhandene ypos gefunden paar
json-tags anz-neu anz-gesetzt anz-geloescht)
(setq texthoehe (ssg-cfg-or "ils_attribut" "texthoehe" 50.0)
layer (ssg-cfg-or "ils_attribut" "layer" "0")
vorhandene nil
ypos 0.0
anz-neu 0
anz-gesetzt 0
anz-geloescht 0
)
;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken.
;; Die Tags werden dabei ueber strcase normalisiert (ATTDEF-Tags haelt
;; BricsCAD ohnehin in Grossschreibung), damit ein klein geschriebener
;; JSON-Tag nicht als "fehlend" gilt und ein Duplikat erzeugt.
(setq ss (ssget "X" '((0 . "ATTDEF"))))
(if ss
(progn
(setq i 0 anzahl (sslength ss))
(while (< i anzahl)
(setq ent (ssname ss i)
ed (entget ent)
tag (cdr (assoc 2 ed))
pt (cdr (assoc 10 ed))
)
(if (null tag) (setq tag ""))
(setq vorhandene (cons (cons (strcase tag) ent) vorhandene))
(if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt)))
(setq i (1+ i))
)
)
)
(setq ypos (- ypos (* texthoehe 2.0)))
(setq json-tags nil)
(foreach paar attribs
(setq tag (strcase (car paar))
wert (cdr paar)
)
(if (null wert) (setq wert ""))
(setq json-tags (cons tag json-tags))
(setq gefunden (cdr (assoc tag vorhandene)))
(if gefunden
(if (iad-update-attdef gefunden wert ersetzen)
(setq anz-gesetzt (1+ anz-gesetzt))
)
(progn
(iad-create-attdef (car paar) wert ypos texthoehe layer)
(setq ypos (- ypos (* texthoehe 2.0)))
(setq anz-neu (1+ anz-neu))
)
)
)
;; Modus "Ersetzen": alle ATTDEFs entfernen, deren Tag nicht in der JSON steht
(if ersetzen
(foreach paar vorhandene
(if (not (member (car paar) json-tags))
(progn
(iad-delete-attdef (cdr paar))
(setq anz-geloescht (1+ anz-geloescht))
)
)
)
)
(list anz-neu anz-gesetzt anz-geloescht)
)
;; ------------------------------------------------------------
;; Sicherheitsfrage vor einem "Ersetzen"-Lauf
;; Rueckgabe: T, wenn der Anwender ausdruecklich "Ja" gewaehlt hat
;; ------------------------------------------------------------
(defun iad-ersetzen-bestaetigt (anzahl-eintraege)
(princ (strcat "\n[ATTR-SYNC] MODUS ERSETZEN: Attribute, die in der JSON nicht"
"\n aufgefuehrt sind, werden in den DWGs GELOESCHT."))
(initget "Ja Nein")
(= (getkword (strcat "\n" (itoa anzahl-eintraege)
" JSON-Eintrag/-Eintraege jetzt verarbeiten? [Ja/Nein] <Nein>: "))
"Ja")
)
;; ------------------------------------------------------------
;; Alle JSON-Eintraege abarbeiten
;; daten = (("Blockname" ("TAG" . "Wert") ...) ...)
;; dwg-dir = Verzeichnis der DWGs (= Verzeichnis der JSON)
;; ersetzen = Modus (siehe iad-sync-attribs-in-current-doc)
;; ------------------------------------------------------------
(defun ils-attr-sync-eintraege (daten dwg-dir ersetzen / orig-doc anzahl-aktualisiert
anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag
blockname attribs dwg-pfad bereits-offen ergebnis
fehlende-liste name summe-neu summe-gesetzt summe-geloescht)
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-aktualisiert 0
anzahl-unveraendert 0
anzahl-fehler 0
anzahl-fehlt 0
fehlende-liste nil
summe-neu 0
summe-gesetzt 0
summe-geloescht 0
)
(princ (strcat "\n[ATTR-SYNC] Modus: " (if ersetzen "Ersetzen" "Ergaenzen")))
(foreach eintrag daten
(setq blockname (car eintrag)
attribs (cdr eintrag)
dwg-pfad (strcat dwg-dir "/" blockname ".dwg")
)
(cond
;; DWG zum JSON-Eintrag fehlt
((not (findfile dwg-pfad))
(setq anzahl-fehlt (1+ anzahl-fehlt))
(setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste))
)
;; Schutz: ein leerer JSON-Eintrag ("Blockname": {}) wuerde im Modus
;; Ersetzen alle ATTDEFs der DWG loeschen. Das ist eher ein Fehler in
;; der JSON als eine Absicht -> DWG unberuehrt lassen und warnen.
((and ersetzen (null attribs))
(princ (strcat "\n[ATTR-SYNC] " blockname ".dwg uebersprungen: JSON-Eintrag"
" ist leer (wuerde alle Attribute loeschen)."))
(setq anzahl-unveraendert (1+ anzahl-unveraendert))
)
(T
(princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ..."))
(setq bereits-offen (iad-find-open-doc dwg-pfad))
(setq ergebnis
(vl-catch-all-apply
(function
(lambda ( / stat)
(if bereits-offen
(progn
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
(setq stat (iad-sync-attribs-in-current-doc attribs ersetzen))
)
(progn
(command "_.OPEN" dwg-pfad)
(setq stat (iad-sync-attribs-in-current-doc attribs ersetzen))
)
)
(if (iad-stat-geaendert stat)
(command "_.QSAVE")
(princ "\n (keine Aenderungen, DWG nicht gespeichert)")
)
(if (not bereits-offen) (command "_.CLOSE"))
stat
)
)
nil
)
)
(if (vl-catch-all-error-p ergebnis)
(progn
(princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: "
(vl-catch-all-error-message ergebnis)))
(setq anzahl-fehler (1+ anzahl-fehler))
)
(progn
(setq summe-neu (+ summe-neu (nth 0 ergebnis))
summe-gesetzt (+ summe-gesetzt (nth 1 ergebnis))
summe-geloescht (+ summe-geloescht (nth 2 ergebnis))
)
(if (iad-stat-geaendert ergebnis)
(setq anzahl-aktualisiert (1+ anzahl-aktualisiert))
(setq anzahl-unveraendert (1+ anzahl-unveraendert))
)
)
)
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(princ (strcat "\n[ATTR-SYNC] Fertig (Modus " (if ersetzen "Ersetzen" "Ergaenzen") "): "
(itoa anzahl-aktualisiert) " DWG(s) aktualisiert, "
(itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), "
(itoa anzahl-fehler) " Fehler, "
(itoa anzahl-fehlt) " nicht gefunden."))
(princ (strcat "\n[ATTR-SYNC] Attribute: " (itoa summe-neu) " neu angelegt, "
(itoa summe-gesetzt) " Werte gesetzt, "
(itoa summe-geloescht) " geloescht."))
(if fehlende-liste
(progn
(princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:")
(foreach name (reverse fehlende-liste)
(princ (strcat "\n - " name))
)
)
)
(princ)
)
;; ------------------------------------------------------------
;; Kernablauf: JSON aus DXFM_DATA/ils lesen und abarbeiten
;; ------------------------------------------------------------
(defun ils-attr-sync-run (ersetzen / data-dir json-pfad dwg-dir daten)
(setq data-dir (getenv "DXFM_DATA"))
(if (not data-dir)
(progn
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
(exit)
)
)
(setq data-dir (vl-string-translate "\\" "/" data-dir))
(setq dwg-dir (strcat data-dir "/ils")
json-pfad (strcat dwg-dir "/allocations.json")
)
(if (not (findfile json-pfad))
(progn
(alert (strcat "JSON nicht gefunden:\n" json-pfad))
(exit)
)
)
(setq daten (ssg-cfg-parse-nested (ssg-read-file-lines json-pfad)))
(if (not daten)
(progn
(alert "JSON konnte nicht gelesen werden oder ist leer.")
(exit)
)
)
(if (and ersetzen (not (iad-ersetzen-bestaetigt (length daten))))
(princ "\n[ATTR-SYNC] Abgebrochen - keine Aenderungen.")
(ils-attr-sync-eintraege daten dwg-dir ersetzen)
)
(princ)
)
;; ------------------------------------------------------------
;; Hauptbefehl - Modus wird interaktiv abgefragt
;; (Grossbuchstaben in initget = zulaessige Abkuerzungen: ERG / ERS)
;; ------------------------------------------------------------
(defun c:ILS_ATTR_SYNC ( / modus)
(initget "ERGaenzen ERSetzen")
(setq modus (getkword "\nModus waehlen [ERGaenzen/ERSetzen] <ERGaenzen>: "))
(if (not modus) (setq modus "ERGaenzen"))
(ils-attr-sync-run (= modus "ERSetzen"))
)
;; ------------------------------------------------------------
;; Direktbefehl fuer den Modus "Ersetzen" (Sicherheitsfrage bleibt)
;; ------------------------------------------------------------
(defun c:ILS_ATTR_REPLACE ()
(ils-attr-sync-run T)
)
(princ "\naddattribute.lisp geladen. Befehle: ILS_ATTR_SYNC, ILS_ATTR_REPLACE")
(princ)
Reference in New Issue View Git Blame Copy Permalink