;; ============================================================
;; 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)