244 lines
8.6 KiB
Common Lisp
244 lines
8.6 KiB
Common Lisp
;; ============================================================
|
|
;; 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)
|