From 2d6fd86d37ffd46935cf3ab39092885306a5dee5 Mon Sep 17 00:00:00 2001 From: Simon Hensch Date: Mon, 20 Jul 2026 07:47:18 +0200 Subject: [PATCH] =?UTF-8?q?[ADD]=20LISP=20Skript=20zum=20Erstellen=20einer?= =?UTF-8?q?=20JSON-Datei=20mit=20allen=20DWG-Bl=C3=B6cken=20und=20deren=20?= =?UTF-8?q?Attributen=20eines=20Verzeichnisses=20und=20Skript=20zum=20Schr?= =?UTF-8?q?eiben=20von=20Attributen=20aus=20einer=20JSON=20auf=20die=20Bl?= =?UTF-8?q?=C3=B6cke=20in=20einem=20Verzeichnis=20entsprechend=20des=20Dat?= =?UTF-8?q?einamens?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lisp/addattribute.lsp | 272 ++++++++++++++++++++++++++++++++++++ Lisp/collect_attributes.lsp | 243 ++++++++++++++++++++++++++++++++ 2 files changed, 515 insertions(+) create mode 100644 Lisp/addattribute.lsp create mode 100644 Lisp/collect_attributes.lsp diff --git a/Lisp/addattribute.lsp b/Lisp/addattribute.lsp new file mode 100644 index 0000000..6653bf0 --- /dev/null +++ b/Lisp/addattribute.lsp @@ -0,0 +1,272 @@ +;; ============================================================ +;; addattribute.lisp +;; Synchronisiert ATTDEF-Attribute in den ILS-Block-DWGs mit den +;; Werten aus allocations.json. +;; +;; Es wird zwischen data/ils/2D und data/ils/3D unterschieden: nach +;; Auswahl des Verzeichnisses wird die dortige allocations.json +;; gelesen (data/ils/<2D|3D>/allocations.json) und anschliessend +;; werden ausschliesslich die DWGs in genau diesem Verzeichnis +;; bearbeitet. +;; +;; Ablauf je JSON-Eintrag "Blockname": {"TAG": "Wert", ...}: +;; - .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. +;; - DWG nur dann speichern, wenn sich mindestens ein Attributwert +;; geaendert hat oder neu angelegt 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. +;; +;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat). +;; +;; Aufruf in BricsCAD: +;; (load "C:/.../data/ils/2D/addattribute.lisp") +;; ILS_ATTR_SYNC +;; ============================================================ + +(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 +) + +;; ------------------------------------------------------------ +;; Ein einzelnes ATTDEF aktualisieren (Ueberschreib-Regel) +;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde +;; ------------------------------------------------------------ +(defun iad-update-attdef (ent jsonwert / 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 (= (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)")) +) + +;; ------------------------------------------------------------ +;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen +;; attribs = (("TAG" . "Wert") ...) +;; Rueckgabe: t, wenn mindestens ein Attribut geaendert/neu angelegt wurde +;; ------------------------------------------------------------ +(defun iad-sync-attribs-in-current-doc (attribs / texthoehe layer ss anzahl i ent ed + tag wert pt vorhandene ypos gefunden paar geaendert) + (setq texthoehe (ssg-cfg-or "ils_attribut" "texthoehe" 50.0) + layer (ssg-cfg-or "ils_attribut" "layer" "0") + vorhandene nil + ypos 0.0 + geaendert nil + ) + ;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken + (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)) + ) + (setq vorhandene (cons (cons tag ent) vorhandene)) + (if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt))) + (setq i (1+ i)) + ) + ) + ) + (setq ypos (- ypos (* texthoehe 2.0))) + + (foreach paar attribs + (setq tag (car paar) + wert (cdr paar) + ) + (if (null wert) (setq wert "")) + (setq gefunden (cdr (assoc tag vorhandene))) + (if gefunden + (if (iad-update-attdef gefunden wert) (setq geaendert t)) + (progn + (iad-create-attdef tag wert ypos texthoehe layer) + (setq ypos (- ypos (* texthoehe 2.0))) + (setq geaendert t) + ) + ) + ) + geaendert +) + +;; ------------------------------------------------------------ +;; Hauptbefehl +;; ------------------------------------------------------------ +(defun c:ILS_ATTR_SYNC ( / data-dir json-pfad dwg-dir dwg-unterverz daten orig-doc anzahl-aktualisiert + anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag blockname attribs + dwg-pfad bereits-offen fehler fehlende-liste name) + (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)) + + (initget "2D 3D") + (setq dwg-unterverz (getkword "\nDWG-Verzeichnis waehlen [2D/3D] <2D>: ")) + (if (not dwg-unterverz) (setq dwg-unterverz "2D")) + (setq dwg-dir (strcat data-dir "/ils/" dwg-unterverz) + 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) + ) + ) + + (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 + ) + + (foreach eintrag daten + (setq blockname (car eintrag) + attribs (cdr eintrag) + dwg-pfad (strcat dwg-dir "/" blockname ".dwg") + ) + (if (findfile dwg-pfad) + (progn + (princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ...")) + (setq bereits-offen (iad-find-open-doc dwg-pfad)) + (setq fehler + (vl-catch-all-apply + (function + (lambda ( / geaendert) + (if bereits-offen + (progn + (vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen) + (setq geaendert (iad-sync-attribs-in-current-doc attribs)) + ) + (progn + (command "_.OPEN" dwg-pfad) + (setq geaendert (iad-sync-attribs-in-current-doc attribs)) + ) + ) + (if geaendert + (command "_.QSAVE") + (princ "\n (keine Aenderungen, DWG nicht gespeichert)") + ) + (if (not bereits-offen) (command "_.CLOSE")) + geaendert + ) + ) + nil + ) + ) + (if (vl-catch-all-error-p fehler) + (progn + (princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: " + (vl-catch-all-error-message fehler))) + (setq anzahl-fehler (1+ anzahl-fehler)) + ) + (if fehler + (setq anzahl-aktualisiert (1+ anzahl-aktualisiert)) + (setq anzahl-unveraendert (1+ anzahl-unveraendert)) + ) + ) + ) + (progn + (setq anzahl-fehlt (1+ anzahl-fehlt)) + (setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste)) + ) + ) + ) + + (vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc) + + (princ (strcat "\n[ATTR-SYNC] Fertig: " (itoa anzahl-aktualisiert) " DWG(s) aktualisiert, " + (itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), " + (itoa anzahl-fehler) " Fehler, " + (itoa anzahl-fehlt) " nicht gefunden.")) + (if fehlende-liste + (progn + (princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:") + (foreach name (reverse fehlende-liste) + (princ (strcat "\n - " name)) + ) + ) + ) + (princ) +) + +(princ "\naddattribute.lisp geladen. Befehl: ILS_ATTR_SYNC") +(princ) diff --git a/Lisp/collect_attributes.lsp b/Lisp/collect_attributes.lsp new file mode 100644 index 0000000..401aef5 --- /dev/null +++ b/Lisp/collect_attributes.lsp @@ -0,0 +1,243 @@ +;; ============================================================ +;; collect_attributes.lsp +;; Sammelt die aktuellen ATTDEF-Werte aller Bloecke (DWG-Dateien) +;; eines Verzeichnisses und schreibt sie als JSON-Datei +;; "allocations_collected.json" - im selben Format wie +;; allocations.json (siehe addattribute.lsp): +;; {"Blockname": {"TAG1": "Wert1", "TAG2": "Wert2", ...}, ...} +;; +;; Wird zunaechst fuer data/ils/2D und data/ils/3D ausgefuehrt - +;; je Verzeichnis entsteht eine eigene allocations_collected.json, +;; direkt im jeweiligen Verzeichnis abgelegt. +;; +;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat). +;; +;; Aufruf in BricsCAD: +;; (load "C:/.../Lisp/collect_attributes.lsp") +;; ILS_ATTR_COLLECT +;; ============================================================ + +(vl-load-com) + +;; ------------------------------------------------------------ +;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil) +;; ------------------------------------------------------------ +(defun cac-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 +) + +;; ------------------------------------------------------------ +;; String fuer JSON escapen (Anfuehrungszeichen/Backslash) +;; ------------------------------------------------------------ +(defun cac-json-escape (s) + (if (null s) (setq s "")) + (setq s (vl-string-subst "\\\\" "\\" s)) + (vl-string-subst "\\\"" "\"" s) +) + +;; ------------------------------------------------------------ +;; Alle ATTDEFs im aktiven Dokument einsammeln (alphabetisch nach +;; Tag sortiert, fuer reproduzierbare Ausgabe) -> (("TAG" . "Wert") ...) +;; ------------------------------------------------------------ +(defun cac-collect-attdefs-in-current-doc ( / ss anzahl i ent ed tag wert ergebnis) + (setq ss (ssget "X" '((0 . "ATTDEF")))) + (setq ergebnis nil) + (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)) + wert (cdr (assoc 1 ed)) + ) + (if (null wert) (setq wert "")) + (setq ergebnis (cons (cons tag wert) ergebnis)) + (setq i (1+ i)) + ) + ) + ) + (vl-sort ergebnis (function (lambda (a b) (< (strcase (car a)) (strcase (car b)))))) +) + +;; ------------------------------------------------------------ +;; Attribut-Alist ((TAG . Wert) ...) als eingerueckten JSON-Objekt- +;; Text formatieren, z.B.: +;; { +;; "TAG1": "Wert1", +;; "TAG2": "Wert2" +;; } +;; einruecken = Einrueckung der schliessenden Klammer +;; ------------------------------------------------------------ +(defun cac-attribs-to-json (attribs einruecken / innen zeilen) + (if (null attribs) + "{}" + (progn + (setq innen (strcat einruecken " ")) + (setq zeilen + (mapcar + (function (lambda (paar) + (strcat innen "\"" (cac-json-escape (car paar)) "\": \"" + (cac-json-escape (cdr paar)) "\"") + )) + attribs + ) + ) + (strcat "{\n" + (car zeilen) + (apply 'strcat (mapcar (function (lambda (z) (strcat ",\n" z))) (cdr zeilen))) + "\n" einruecken "}" + ) + ) + ) +) + +;; ------------------------------------------------------------ +;; Eine DWG-Datei oeffnen (falls noetig), ATTDEFs einsammeln und +;; die Datei wieder schliessen (falls durch diese Funktion geoeffnet). +;; Rueckgabe: ('ok . (("TAG" . "Wert") ...)) oder ('fehler . meldung) +;; ------------------------------------------------------------ +(defun cac-collect-dwg (dwg-pfad / bereits-offen ergebnis fehler) + (setq bereits-offen (cac-find-open-doc dwg-pfad)) + (setq ergebnis nil) + (setq fehler + (vl-catch-all-apply + (function + (lambda () + (if bereits-offen + (vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen) + (command "_.OPEN" dwg-pfad) + ) + (setq ergebnis (cac-collect-attdefs-in-current-doc)) + (if (not bereits-offen) (command "_.CLOSE")) + ) + ) + nil + ) + ) + (if (vl-catch-all-error-p fehler) + (cons 'fehler (vl-catch-all-error-message fehler)) + (cons 'ok ergebnis) + ) +) + +;; ------------------------------------------------------------ +;; Alle *.dwg eines Verzeichnisses einlesen und als +;; allocations_collected.json (json-pfad) schreiben. +;; ------------------------------------------------------------ +(defun cac-collect-directory (dwg-dir json-pfad / dateien datei dwg-pfad orig-doc + blockname ergebnis anzahl-ok anzahl-fehler + fehler-liste eintraege fh erste paar) + (setq dwg-dir (vl-string-right-trim "/" (vl-string-translate "\\" "/" dwg-dir))) + (if (not (findfile dwg-dir)) + (princ (strcat "\n[ATTR-COLLECT] Verzeichnis nicht gefunden, uebersprungen: " dwg-dir)) + (progn + (setq dateien (vl-directory-files dwg-dir "*.dwg" 1)) + (if (not dateien) + (princ (strcat "\n[ATTR-COLLECT] Keine DWG-Dateien in: " dwg-dir)) + (progn + (setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object)) + anzahl-ok 0 + anzahl-fehler 0 + fehler-liste nil + eintraege nil + ) + (foreach datei dateien + (setq blockname (vl-filename-base datei) + dwg-pfad (strcat dwg-dir "/" datei) + ) + (princ (strcat "\n[ATTR-COLLECT] Lese " datei " ...")) + (setq ergebnis (cac-collect-dwg dwg-pfad)) + (if (equal (car ergebnis) 'fehler) + (progn + (princ (strcat "\n[ATTR-COLLECT] FEHLER bei " datei ": " (cdr ergebnis))) + (setq anzahl-fehler (1+ anzahl-fehler)) + (setq fehler-liste (cons datei fehler-liste)) + ) + (progn + (setq eintraege (cons (cons blockname (cdr ergebnis)) eintraege)) + (setq anzahl-ok (1+ anzahl-ok)) + ) + ) + ) + (vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc) + (setq eintraege (reverse eintraege)) + + ;; JSON schreiben + (setq fh (open json-pfad "w")) + (if (null fh) + (princ (strcat "\n[ATTR-COLLECT] FEHLER: Datei kann nicht geschrieben werden: " json-pfad)) + (progn + (write-line "{" fh) + (setq erste T) + (foreach paar eintraege + (if (not erste) (write-line "," fh)) + (write-line (strcat " \"" (cac-json-escape (car paar)) "\": " + (cac-attribs-to-json (cdr paar) " ")) + fh) + (setq erste nil) + ) + (write-line "}" fh) + (close fh) + (princ (strcat "\n[ATTR-COLLECT] " json-pfad " geschrieben (" + (itoa anzahl-ok) " Bloecke).")) + ) + ) + + (princ (strcat "\n[ATTR-COLLECT] " dwg-dir " fertig: " + (itoa anzahl-ok) " gelesen, " + (itoa anzahl-fehler) " Fehler.")) + (if fehler-liste + (progn + (princ "\n[ATTR-COLLECT] WARNUNG: Fehler bei:") + (foreach datei (reverse fehler-liste) + (princ (strcat "\n - " datei)) + ) + ) + ) + ) + ) + ) + ) + (princ) +) + +;; ------------------------------------------------------------ +;; Hauptbefehl - verarbeitet DXFM_DATA/ils/2D und DXFM_DATA/ils/3D +;; ------------------------------------------------------------ +(defun c:ILS_ATTR_COLLECT ( / data-dir basis-dir subverz dwg-dir json-pfad) + (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) + basis-dir (strcat data-dir "/ils") + ) + + (foreach subverz '("2D" "3D") + (setq dwg-dir (strcat basis-dir "/" subverz) + json-pfad (strcat dwg-dir "/allocations_collected.json") + ) + (princ (strcat "\n[ATTR-COLLECT] === " subverz " ===")) + (cac-collect-directory dwg-dir json-pfad) + ) + (princ) +) + +(princ "\ncollect_attributes.lsp geladen. Befehl: ILS_ATTR_COLLECT") +(princ)