From 52b0699862132d6d44f4df9dc21e3536941d8ec7 Mon Sep 17 00:00:00 2001 From: Simon Hensch Date: Wed, 16 Sep 2026 11:47:26 +0200 Subject: [PATCH] =?UTF-8?q?[ADD]=20Lisp=20Skripte=20zu=20Erzeugung=20einer?= =?UTF-8?q?=20JSON=20mit=20den=20jeweiligen=20Attributen=20von=20mehreren?= =?UTF-8?q?=20DWG=20Dateien=20und=20zur=20=C3=9Cberschreibung=20der=20Attr?= =?UTF-8?q?ibute=20aus=20einer=20JSON?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lisp/list_blocks.lsp | 314 ++++++++++++++++++++++++++++++++++++++++++ Lisp/purge_blocks.lsp | 225 ++++++++++++++++++++++++++++++ 2 files changed, 539 insertions(+) create mode 100644 Lisp/list_blocks.lsp create mode 100644 Lisp/purge_blocks.lsp diff --git a/Lisp/list_blocks.lsp b/Lisp/list_blocks.lsp new file mode 100644 index 0000000..c3ecad9 --- /dev/null +++ b/Lisp/list_blocks.lsp @@ -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: +;; { "": { "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 = (("" "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) diff --git a/Lisp/purge_blocks.lsp b/Lisp/purge_blocks.lsp new file mode 100644 index 0000000..93801c7 --- /dev/null +++ b/Lisp/purge_blocks.lsp @@ -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)