Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

[ADD] LISP Skript zum Erstellen einer JSON-Datei mit allen DWG-Blöcken und deren Attributen eines Verzeichnisses und Skript zum Schreiben von Attributen aus einer JSON auf die Blöcke in einem Verzeichnis entsprechend des Dateinamens

Browse Source
This commit is contained in:
Simon Hensch
2026-07-20 07:47:18 +02:00
parent e2aee8c413
commit 2d6fd86d37
2 changed files with 515 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/addattribute.lsp
+272
View File
@@ -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", ...}:
;; - <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.
;; - 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)
Lisp/collect_attributes.lsp
+243
View File
@@ -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)