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