[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
This commit is contained in:
@@ -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)
|
||||
Reference in New Issue
Block a user