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

[ADD] Lisp Skripte zu Erzeugung einer JSON mit den jeweiligen Attributen von mehreren DWG Dateien und zur Überschreibung der Attribute aus einer JSON

Browse Source
This commit is contained in:
Simon Hensch
2026-09-16 11:47:26 +02:00
parent 3fdbfa4cb1
commit 52b0699862
2 changed files with 539 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/list_blocks.lsp
+314
View File
@@ -0,0 +1,314 @@
;; ============================================================
;; list_blocks.lsp
;; Liest die (Sub-)Block-Definitionen aller DWG-Dateien in
;; data/ils aus und schreibt sie als JSON-Report
;; "blocks_collected.json" nach data/ils.
;;
;; Hintergrund: 2D- und 3D-Bloecke (z.B.
;; Vario_Bogen_ab_27_TEF_rechts_2D.dwg /
;; Vario_Bogen_ab_27_TEF_rechts_3D.dwg)
;; enthalten teilweise gleichnamige Sub-Bloecke (z.B.
;; "200000317_TEF_Bogen_vertikal_abwaerts__15"). Werden beide
;; DWGs in dieselbe Zeichnung eingefuegt, kollidieren diese
;; Definitionen (nur eine Referenz gewinnt). Dieses Skript LIEST
;; die Bloecke nur aus, damit manuell entschieden werden kann,
;; welche spaeter mit "_2D"/"_3D" umbenannt werden.
;;
;; Ausgabe:
;; - JSON data/ils/blocks_collected.json:
;; { "<Dateiname ohne .dwg>": { "dim": "2D"|"3D"|"-",
;; "blocks": ["Name", ...] }, ... }
;; - Konsolen-Report inkl. Kollisionsliste (gleicher Blockname
;; kommt sowohl in einer _2D- als auch in einer _3D-Datei vor)
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../Lisp/list_blocks.lsp")
;; ILS_BLOCK_LIST
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun lb-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 lb-json-escape (s)
(if (null s) (setq s ""))
(setq s (vl-string-subst "\\\\" "\\" s))
(vl-string-subst "\\\"" "\"" s)
)
;; ------------------------------------------------------------
;; Strings mit Trennzeichen verbinden
;; ------------------------------------------------------------
(defun lb-strjoin (liste sep / erg erste s)
(setq erg "" erste T)
(foreach s liste
(if erste (setq erg s erste nil) (setq erg (strcat erg sep s)))
)
erg
)
;; ------------------------------------------------------------
;; Dimension aus dem Dateinamen ableiten ("2D"/"3D"/"-")
;; ------------------------------------------------------------
(defun lb-dim-aus-name (basisname / n)
(setq n (strcase basisname))
(cond
((wcmatch n "*_2D") "2D")
((wcmatch n "*_3D") "3D")
(t "-")
)
)
;; ------------------------------------------------------------
;; Alle echten (Sub-)Block-Definitionen des aktiven Dokuments
;; einsammeln (Symboltabelle BLOCK): keine Layouts (Model/Paper-
;; Space, "*..."), keine anonymen Bloecke (Flag 1), keine XRefs
;; (Flag 4). Alphabetisch sortiert.
;; ------------------------------------------------------------
(defun lb-collect-blocks-in-current-doc ( / def name flags ergebnis)
(setq ergebnis nil
def (tblnext "BLOCK" T)
)
(while def
(setq name (cdr (assoc 2 def))
flags (cdr (assoc 70 def))
)
(if (null flags) (setq flags 0))
(if (and name
(> (strlen name) 0)
(/= (substr name 1 1) "*") ; kein Model/Paper-Space
(= (logand flags 1) 0) ; nicht anonym
(= (logand flags 4) 0) ; kein XRef
)
(setq ergebnis (cons name ergebnis))
)
(setq def (tblnext "BLOCK"))
)
(vl-sort ergebnis (function (lambda (a b) (< (strcase a) (strcase b)))))
)
;; ------------------------------------------------------------
;; Eine DWG-Datei oeffnen (falls noetig), Bloecke einsammeln und
;; die Datei wieder schliessen (falls durch diese Funktion geoeffnet).
;; Rueckgabe: ('ok . ("Name" ...)) oder ('fehler . meldung)
;; ------------------------------------------------------------
(defun lb-collect-dwg (dwg-pfad / bereits-offen ergebnis fehler)
(setq bereits-offen (lb-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 (lb-collect-blocks-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)
)
)
;; ------------------------------------------------------------
;; Liste als JSON-Array-Text formatieren (["a", "b"]), eingerueckt
;; ------------------------------------------------------------
(defun lb-list-to-json (namen einruecken / innen zeilen)
(if (null namen)
"[]"
(progn
(setq innen (strcat einruecken " "))
(setq zeilen
(mapcar
(function (lambda (nm) (strcat innen "\"" (lb-json-escape nm) "\"")))
namen
)
)
(strcat "[\n"
(car zeilen)
(apply 'strcat (mapcar (function (lambda (z) (strcat ",\n" z))) (cdr zeilen)))
"\n" einruecken "]"
)
)
)
)
;; ------------------------------------------------------------
;; Kollisionen ermitteln: Bloecke, deren Name sowohl in einer
;; _2D- als auch in einer _3D-Datei vorkommt.
;; eintraege = (("<datei>" "2D"|"3D"|"-" ("blk" ...)) ...)
;; Rueckgabe: (("blockname" ("datei-2d" ...) ("datei-3d" ...)) ...)
;; ------------------------------------------------------------
(defun lb-finde-kollisionen (eintraege / tabelle e datei dim blks blk vorhanden coll)
;; tabelle: blockname -> (liste-2d-dateien . liste-3d-dateien)
(setq tabelle nil)
(foreach e eintraege
(setq datei (nth 0 e)
dim (nth 1 e)
blks (nth 2 e)
)
(foreach blk blks
(setq vorhanden (assoc blk tabelle))
(if (not vorhanden)
(setq vorhanden (list blk nil nil)
tabelle (cons vorhanden tabelle))
)
(cond
((= dim "2D") (setq vorhanden (subst (cons datei (nth 1 vorhanden)) (nth 1 vorhanden) vorhanden)))
((= dim "3D") (setq vorhanden (subst (cons datei (nth 2 vorhanden)) (nth 2 vorhanden) vorhanden)))
)
;; aktualisierten Eintrag zurueckschreiben
(setq tabelle (subst vorhanden (assoc blk tabelle) tabelle))
)
)
;; nur Bloecke mit mind. einer 2D- UND einer 3D-Datei
(setq coll nil)
(foreach e tabelle
(if (and (nth 1 e) (nth 2 e))
(setq coll (cons e coll))
)
)
(vl-sort coll (function (lambda (a b) (< (strcase (car a)) (strcase (car b))))))
)
;; ------------------------------------------------------------
;; Hauptbefehl - verarbeitet DXFM_DATA/ils
;; ------------------------------------------------------------
(defun c:ILS_BLOCK_LIST ( / data-dir dwg-dir json-pfad dateien datei dwg-pfad basisname
dim ergebnis orig-doc anzahl-ok anzahl-fehler fehler-liste
eintraege fh erste e kollisionen k)
(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)
dwg-dir (strcat data-dir "/ils")
json-pfad (strcat dwg-dir "/blocks_collected.json")
)
(setq dwg-dir (vl-string-right-trim "/" dwg-dir))
(if (not (findfile dwg-dir))
(progn
(princ (strcat "\n[BLOCK-LIST] Verzeichnis nicht gefunden: " dwg-dir))
(exit)
)
)
(setq dateien (vl-directory-files dwg-dir "*.dwg" 1))
(if (not dateien)
(progn
(princ (strcat "\n[BLOCK-LIST] Keine DWG-Dateien in: " dwg-dir))
(exit)
)
)
(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 basisname (vl-filename-base datei)
dwg-pfad (strcat dwg-dir "/" datei)
dim (lb-dim-aus-name basisname)
)
(princ (strcat "\n[BLOCK-LIST] Lese " datei " ..."))
(setq ergebnis (lb-collect-dwg dwg-pfad))
(if (equal (car ergebnis) 'fehler)
(progn
(princ (strcat "\n[BLOCK-LIST] FEHLER bei " datei ": " (cdr ergebnis)))
(setq anzahl-fehler (1+ anzahl-fehler))
(setq fehler-liste (cons datei fehler-liste))
)
(progn
(setq eintraege (cons (list basisname dim (cdr ergebnis)) eintraege))
(setq anzahl-ok (1+ anzahl-ok))
(princ (strcat " " (itoa (length (cdr ergebnis))) " Block(e)."))
)
)
)
(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[BLOCK-LIST] FEHLER: Datei kann nicht geschrieben werden: " json-pfad))
(progn
(write-line "{" fh)
(setq erste T)
(foreach e eintraege
(if (not erste) (write-line "," fh))
(write-line (strcat " \"" (lb-json-escape (nth 0 e)) "\": {") fh)
(write-line (strcat " \"dim\": \"" (nth 1 e) "\",") fh)
(write-line (strcat " \"blocks\": " (lb-list-to-json (nth 2 e) " ")) fh)
(write-line " }" fh)
(setq erste nil)
)
(write-line "}" fh)
(close fh)
(princ (strcat "\n[BLOCK-LIST] " json-pfad " geschrieben ("
(itoa anzahl-ok) " Dateien)."))
)
)
;; Kollisionen ermitteln und ausgeben
(setq kollisionen (lb-finde-kollisionen eintraege))
(princ (strcat "\n[BLOCK-LIST] Fertig: " (itoa anzahl-ok) " gelesen, "
(itoa anzahl-fehler) " Fehler, "
(itoa (length kollisionen)) " Kollision(en) (Blockname in 2D UND 3D)."))
(if kollisionen
(progn
(princ "\n[BLOCK-LIST] --- Kollisionen (Kandidaten fuer _2D/_3D-Umbenennung) ---")
(foreach k kollisionen
(princ (strcat "\n * " (car k)))
(princ (strcat "\n 2D: " (lb-strjoin (reverse (nth 1 k)) ", ")))
(princ (strcat "\n 3D: " (lb-strjoin (reverse (nth 2 k)) ", ")))
)
)
)
(if fehler-liste
(progn
(princ "\n[BLOCK-LIST] WARNUNG: Fehler bei:")
(foreach datei (reverse fehler-liste)
(princ (strcat "\n - " datei))
)
)
)
(princ)
)
(princ "\nlist_blocks.lsp geladen. Befehl: ILS_BLOCK_LIST")
(princ)
Lisp/purge_blocks.lsp
+225
View File
@@ -0,0 +1,225 @@
;; ============================================================
;; purge_blocks.lsp
;; Entfernt in allen DWG-Dateien in data/ils die nicht
;; verwendeten Block-Definitionen und Layer (-PURGE Blocks/Layer).
;;
;; Ablauf je DWG:
;; - Datei oeffnen (falls noetig)
;; - Block- und Layer-Anzahl zaehlen
;; - -PURGE Blocks und -PURGE Layer in einer Schleife ausfuehren,
;; bis nichts mehr entfernt wird (verschachtelte Bloecke bzw.
;; nur von entfernten Bloecken benutzte Layer werden erst nach
;; dem ersten Durchlauf frei)
;; - nur speichern, wenn sich die Anzahl verringert hat
;; - schliessen (falls durch dieses Skript geoeffnet)
;;
;; Es werden AUSSCHLIESSLICH unbenutzte Bloecke und Layer entfernt.
;; Andere Objekttypen (Linientypen, Textstile, ...) bleiben
;; unangetastet.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;; (load "C:/.../Lisp/purge_blocks.lsp")
;; ILS_BLOCK_PURGE
;; ============================================================
(vl-load-com)
;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun pb-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
)
;; ------------------------------------------------------------
;; Anzahl aller Eintraege einer Symboltabelle zaehlen
;; (z.B. "BLOCK" inkl. Model/Paper-Space/anonyme, "LAYER").
;; ------------------------------------------------------------
(defun pb-count-table (tabelle / n def)
(setq n 0 def (tblnext tabelle T))
(while def
(setq n (1+ n))
(setq def (tblnext tabelle))
)
n
)
;; ------------------------------------------------------------
;; Im aktiven Dokument unbenutzte Bloecke UND Layer purgen, bis
;; stabil. Erst Bloecke, dann Layer (ein nur von einem entfernten
;; Block benutzter Layer wird erst danach frei) - daher Schleife
;; ueber beide Typen, bis sich nichts mehr aendert.
;; ------------------------------------------------------------
(defun pb-purge-current-doc ( / vorher aktuell durchlauf max-durchlauf)
(setq vorher (+ (pb-count-table "BLOCK") (pb-count-table "LAYER"))
aktuell vorher
durchlauf 1
max-durchlauf 20
)
(while (and (<= durchlauf max-durchlauf)
(progn
(command "_.-PURGE" "_B" "*" "_N") ; unbenutzte Bloecke
(command "_.-PURGE" "_LA" "*" "_N") ; unbenutzte Layer
(setq aktuell (+ (pb-count-table "BLOCK") (pb-count-table "LAYER")))
;; weiter, solange noch etwas entfernt wurde
(if (< aktuell vorher)
(progn (setq vorher aktuell) T)
nil
)
)
)
(setq durchlauf (1+ durchlauf))
)
aktuell
)
;; ------------------------------------------------------------
;; Eine DWG-Datei oeffnen (falls noetig), purgen, speichern (nur
;; bei Aenderung) und schliessen (falls hier geoeffnet).
;; Rueckgabe: ('ok blk-entfernt . lay-entfernt) oder ('fehler . meldung)
;; ------------------------------------------------------------
(defun pb-purge-dwg (dwg-pfad / bereits-offen blk-vor blk-nach lay-vor lay-nach
blk-entfernt lay-entfernt fehler)
(setq bereits-offen (pb-find-open-doc dwg-pfad))
(setq blk-entfernt 0 lay-entfernt 0)
(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 blk-vor (pb-count-table "BLOCK")
lay-vor (pb-count-table "LAYER")
)
(pb-purge-current-doc)
(setq blk-nach (pb-count-table "BLOCK")
lay-nach (pb-count-table "LAYER")
blk-entfernt (- blk-vor blk-nach)
lay-entfernt (- lay-vor lay-nach)
)
(if (or (> blk-entfernt 0) (> lay-entfernt 0))
(command "_.QSAVE")
)
(if (not bereits-offen) (command "_.CLOSE"))
)
)
nil
)
)
(if (vl-catch-all-error-p fehler)
(cons 'fehler (vl-catch-all-error-message fehler))
(list 'ok blk-entfernt lay-entfernt)
)
)
;; ------------------------------------------------------------
;; Hauptbefehl - verarbeitet DXFM_DATA/ils
;; ------------------------------------------------------------
(defun c:ILS_BLOCK_PURGE ( / data-dir dwg-dir dateien datei dwg-pfad ergebnis
orig-doc anzahl-ok anzahl-fehler summe-blk summe-lay
blk lay fehler-liste geaendert-liste)
(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)
dwg-dir (vl-string-right-trim "/" (strcat data-dir "/ils"))
)
(if (not (findfile dwg-dir))
(progn
(princ (strcat "\n[BLOCK-PURGE] Verzeichnis nicht gefunden: " dwg-dir))
(exit)
)
)
(setq dateien (vl-directory-files dwg-dir "*.dwg" 1))
(if (not dateien)
(progn
(princ (strcat "\n[BLOCK-PURGE] Keine DWG-Dateien in: " dwg-dir))
(exit)
)
)
(setq orig-doc (vla-get-ActiveDocument (vlax-get-acad-object))
anzahl-ok 0
anzahl-fehler 0
summe-blk 0
summe-lay 0
fehler-liste nil
geaendert-liste nil
)
(foreach datei dateien
(setq dwg-pfad (strcat dwg-dir "/" datei))
(princ (strcat "\n[BLOCK-PURGE] Bearbeite " datei " ..."))
(setq ergebnis (pb-purge-dwg dwg-pfad))
(if (equal (car ergebnis) 'fehler)
(progn
(princ (strcat "\n[BLOCK-PURGE] FEHLER bei " datei ": " (cdr ergebnis)))
(setq anzahl-fehler (1+ anzahl-fehler))
(setq fehler-liste (cons datei fehler-liste))
)
(progn
(setq anzahl-ok (1+ anzahl-ok)
blk (nth 1 ergebnis)
lay (nth 2 ergebnis)
)
(if (or (> blk 0) (> lay 0))
(progn
(princ (strcat " " (itoa blk) " Block(e), " (itoa lay) " Layer entfernt, gespeichert."))
(setq summe-blk (+ summe-blk blk)
summe-lay (+ summe-lay lay)
)
(setq geaendert-liste (cons (strcat datei " (B:" (itoa blk) " L:" (itoa lay) ")") geaendert-liste))
)
(princ " keine unbenutzten Bloecke/Layer.")
)
)
)
)
(vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
(princ (strcat "\n[BLOCK-PURGE] Fertig: " (itoa anzahl-ok) " Datei(en) bearbeitet, "
(itoa summe-blk) " Block(e), "
(itoa summe-lay) " Layer entfernt, "
(itoa anzahl-fehler) " Fehler."))
(if geaendert-liste
(progn
(princ "\n[BLOCK-PURGE] Geaenderte Dateien:")
(foreach datei (reverse geaendert-liste)
(princ (strcat "\n - " datei))
)
)
)
(if fehler-liste
(progn
(princ "\n[BLOCK-PURGE] WARNUNG: Fehler bei:")
(foreach datei (reverse fehler-liste)
(princ (strcat "\n - " datei))
)
)
)
(princ)
)
(princ "\npurge_blocks.lsp geladen. Befehl: ILS_BLOCK_PURGE")
(princ)