mistangl/dxfmakros
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d0fe890d7c9a850ece7cf702705fa6839f451ea5
dxfmakros/Lisp/list_blocks.lsp
T

315 lines
11 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; 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)
Reference in New Issue View Git Blame Copy Permalink