;; ============================================================
;; addattribute.lisp
;; Synchronisiert ATTDEF-Attribute in den ILS-Block-DWGs mit den
;; Werten aus allocations.json.
;;
;; Es wird die allocations.json aus data/ils gelesen
;; (data/ils/allocations.json) und anschliessend werden
;; ausschliesslich die DWGs in genau diesem Verzeichnis bearbeitet.
;;
;; Es gibt zwei Modi (Auswahl beim Befehlsaufruf):
;;
;; MODUS "Ergaenzen" (Vorgabe, bisheriges Verhalten)
;; Ablauf je JSON-Eintrag  "Blockname": {"TAG": "Wert", ...}:
;;   - <Blockname>.dwg im selben Verzeichnis wie die JSON oeffnen
;;   - je Attribut (TAG/Wert):
;;       - ATTDEF mit diesem Tag existiert nicht  -> neu anlegen,
;;         Vorgabewert = JSON-Wert (auch wenn dieser leer ist)
;;       - ATTDEF existiert, ist aber leer        -> mit JSON-Wert befuellen
;;       - ATTDEF existiert und ist bereits befuellt
;;                                                 -> NUR ueberschreiben,
;;         wenn der JSON-Wert NICHT leer ("") ist. Ein leerer JSON-Wert
;;         loescht also nie einen bereits vorhandenen Wert.
;;   - ATTDEFs, die in der JSON nicht vorkommen, bleiben unberuehrt.
;;
;; MODUS "Ersetzen" (die JSON ist die alleinige Quelle der Wahrheit)
;;   - JSON-Wert wird IMMER gesetzt, auch ein leerer Wert (der Wert des
;;     ATTDEF wird dann geleert)
;;   - Tags, die in der DWG fehlen, werden neu angelegt
;;   - ATTDEFs, deren Tag NICHT in der JSON steht, werden GELOESCHT
;;   - vorhandene ATTDEFs werden dabei in-place geaendert, behalten also
;;     Position, Texthoehe, Layer und Stil (im Unterschied zu
;;     data/omniflo/2D/addattributes.py --replace, das alles neu stapelt)
;;
;; In beiden Modi gilt:
;;   - DWG nur dann speichern, wenn sich mindestens ein Attributwert
;;     geaendert hat, neu angelegt oder geloescht wurde (bessere
;;     Nachverfolgbarkeit im Versionsvergleich). Falls durch dieses
;;     Skript geoeffnet, wird die DWG anschliessend wieder geschlossen.
;;     War die DWG schon vorher offen, bleibt sie offen.
;;
;; TIPP vor dem ersten "Ersetzen"-Lauf: mit ILS_ATTR_COLLECT
;; (collect_attributes.lsp) den Ist-Zustand als allocations_collected.json
;; schreiben und gegen allocations.json vergleichen - jeder Tag, der nur
;; in der Collected-Datei steht, wird beim Ersetzen geloescht.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;;   (load "C:/.../Lisp/addattribute.lsp")
;;   ILS_ATTR_SYNC      ; fragt den Modus ab (Vorgabe: Ergaenzen)
;;   ILS_ATTR_REPLACE   ; direkt Modus "Ersetzen" (mit Sicherheitsfrage)
;; ============================================================

(vl-load-com)

;; ssg_core.lsp (JSON-Parser ssg-cfg-parse-nested) sicherstellen,
;; falls das Menue/die Kern-Module noch nicht geladen wurden.
(if (not (car (atoms-family 1 '("SSG-CFG-PARSE-NESTED"))))
  (if (getenv "DXFM_LISP")
    (load (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_core.lsp"))
  )
)

;; ------------------------------------------------------------
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
;; ------------------------------------------------------------
(defun iad-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
)

;; ------------------------------------------------------------
;; Statistik-Liste (anz-neu anz-gesetzt anz-geloescht):
;; hat sich ueberhaupt etwas geaendert?
;; (Achtung: eine Liste aus Nullen ist in LISP truthy, daher diese
;;  explizite Pruefung statt eines einfachen if.)
;; ------------------------------------------------------------
(defun iad-stat-geaendert (stat)
  (and stat (> (apply '+ stat) 0))
)

;; ------------------------------------------------------------
;; Ein einzelnes ATTDEF aktualisieren
;; ersetzen = T -> JSON-Wert immer setzen (auch leer)
;; ersetzen = nil -> ein befuellter Wert bleibt bei leerem JSON-Wert stehen
;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde
;; ------------------------------------------------------------
(defun iad-update-attdef (ent jsonwert ersetzen / ed altwert)
  (setq ed      (entget ent)
        altwert (cdr (assoc 1 ed))
  )
  (if (null altwert) (setq altwert ""))
  (cond
    ((equal altwert jsonwert)
     (princ (strcat "\n    = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert)"))
     nil
    )
    ((or ersetzen (= (strlen altwert) 0) (> (strlen jsonwert) 0))
     (entmod (subst (cons 1 jsonwert) (assoc 1 ed) ed))
     (princ (strcat "\n    - " (cdr (assoc 2 ed)) " = '" jsonwert "'"))
     t
    )
    (t
     (princ (strcat "\n    = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert, JSON-Wert leer)"))
     nil
    )
  )
)

;; ------------------------------------------------------------
;; Neues (unsichtbares) ATTDEF anlegen
;; ------------------------------------------------------------
(defun iad-create-attdef (tag wert ypos texthoehe layer)
  (entmake (list
    '(0 . "ATTDEF")
    (cons 8 layer)
    (cons 10 (list 0.0 ypos 0.0))
    (cons 40 texthoehe)
    (cons 1 wert)
    (cons 3 tag)
    (cons 2 tag)
    '(70 . 1)
  ))
  (princ (strcat "\n    + " tag " = '" wert "' (neu angelegt)"))
)

;; ------------------------------------------------------------
;; Vorhandenes ATTDEF loeschen (nur Modus "Ersetzen")
;; ------------------------------------------------------------
(defun iad-delete-attdef (ent / ed altwert)
  (setq ed      (entget ent)
        altwert (cdr (assoc 1 ed))
  )
  (if (null altwert) (setq altwert ""))
  (princ (strcat "\n    x " (cdr (assoc 2 ed)) " = '" altwert "' (geloescht)"))
  (entdel ent)
)

;; ------------------------------------------------------------
;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
;; attribs  = (("TAG" . "Wert") ...)
;; ersetzen = T -> JSON ist die alleinige Quelle der Wahrheit
;;                 (Werte immer setzen, ueberzaehlige ATTDEFs loeschen)
;; Rueckgabe: Statistik-Liste (anz-neu anz-gesetzt anz-geloescht)
;; ------------------------------------------------------------
(defun iad-sync-attribs-in-current-doc (attribs ersetzen / texthoehe layer ss anzahl i ent ed
                                          tag wert pt vorhandene ypos gefunden paar
                                          json-tags anz-neu anz-gesetzt anz-geloescht)
  (setq texthoehe (ssg-cfg-or "ils_attribut" "texthoehe" 50.0)
        layer     (ssg-cfg-or "ils_attribut" "layer" "0")
        vorhandene nil
        ypos       0.0
        anz-neu       0
        anz-gesetzt   0
        anz-geloescht 0
  )
  ;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken.
  ;; Die Tags werden dabei ueber strcase normalisiert (ATTDEF-Tags haelt
  ;; BricsCAD ohnehin in Grossschreibung), damit ein klein geschriebener
  ;; JSON-Tag nicht als "fehlend" gilt und ein Duplikat erzeugt.
  (setq ss (ssget "X" '((0 . "ATTDEF"))))
  (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))
              pt  (cdr (assoc 10 ed))
        )
        (if (null tag) (setq tag ""))
        (setq vorhandene (cons (cons (strcase tag) ent) vorhandene))
        (if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt)))
        (setq i (1+ i))
      )
    )
  )
  (setq ypos (- ypos (* texthoehe 2.0)))

  (setq json-tags nil)
  (foreach paar attribs
    (setq tag  (strcase (car paar))
          wert (cdr paar)
    )
    (if (null wert) (setq wert ""))
    (setq json-tags (cons tag json-tags))
    (setq gefunden (cdr (assoc tag vorhandene)))
    (if gefunden
      (if (iad-update-attdef gefunden wert ersetzen)
        (setq anz-gesetzt (1+ anz-gesetzt))
      )
      (progn
        (iad-create-attdef (car paar) wert ypos texthoehe layer)
        (setq ypos (- ypos (* texthoehe 2.0)))
        (setq anz-neu (1+ anz-neu))
      )
    )
  )

  ;; Modus "Ersetzen": alle ATTDEFs entfernen, deren Tag nicht in der JSON steht
  (if ersetzen
    (foreach paar vorhandene
      (if (not (member (car paar) json-tags))
        (progn
          (iad-delete-attdef (cdr paar))
          (setq anz-geloescht (1+ anz-geloescht))
        )
      )
    )
  )

  (list anz-neu anz-gesetzt anz-geloescht)
)

;; ------------------------------------------------------------
;; Sicherheitsfrage vor einem "Ersetzen"-Lauf
;; Rueckgabe: T, wenn der Anwender ausdruecklich "Ja" gewaehlt hat
;; ------------------------------------------------------------
(defun iad-ersetzen-bestaetigt (anzahl-eintraege)
  (princ (strcat "\n[ATTR-SYNC] MODUS ERSETZEN: Attribute, die in der JSON nicht"
                 "\n            aufgefuehrt sind, werden in den DWGs GELOESCHT."))
  (initget "Ja Nein")
  (= (getkword (strcat "\n" (itoa anzahl-eintraege)
                       " JSON-Eintrag/-Eintraege jetzt verarbeiten? [Ja/Nein] <Nein>: "))
     "Ja")
)

;; ------------------------------------------------------------
;; Alle JSON-Eintraege abarbeiten
;; daten    = (("Blockname" ("TAG" . "Wert") ...) ...)
;; dwg-dir  = Verzeichnis der DWGs (= Verzeichnis der JSON)
;; ersetzen = Modus (siehe iad-sync-attribs-in-current-doc)
;; ------------------------------------------------------------
(defun ils-attr-sync-eintraege (daten dwg-dir ersetzen / orig-doc anzahl-aktualisiert
                                 anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag
                                 blockname attribs dwg-pfad bereits-offen ergebnis
                                 fehlende-liste name summe-neu summe-gesetzt summe-geloescht)
  (setq orig-doc          (vla-get-ActiveDocument (vlax-get-acad-object))
        anzahl-aktualisiert 0
        anzahl-unveraendert 0
        anzahl-fehler       0
        anzahl-fehlt        0
        fehlende-liste      nil
        summe-neu           0
        summe-gesetzt       0
        summe-geloescht     0
  )

  (princ (strcat "\n[ATTR-SYNC] Modus: " (if ersetzen "Ersetzen" "Ergaenzen")))

  (foreach eintrag daten
    (setq blockname (car eintrag)
          attribs   (cdr eintrag)
          dwg-pfad  (strcat dwg-dir "/" blockname ".dwg")
    )
    (cond
      ;; DWG zum JSON-Eintrag fehlt
      ((not (findfile dwg-pfad))
        (setq anzahl-fehlt (1+ anzahl-fehlt))
        (setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste))
      )

      ;; Schutz: ein leerer JSON-Eintrag ("Blockname": {}) wuerde im Modus
      ;; Ersetzen alle ATTDEFs der DWG loeschen. Das ist eher ein Fehler in
      ;; der JSON als eine Absicht -> DWG unberuehrt lassen und warnen.
      ((and ersetzen (null attribs))
        (princ (strcat "\n[ATTR-SYNC] " blockname ".dwg uebersprungen: JSON-Eintrag"
                       " ist leer (wuerde alle Attribute loeschen)."))
        (setq anzahl-unveraendert (1+ anzahl-unveraendert))
      )

      (T
        (princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ..."))
        (setq bereits-offen (iad-find-open-doc dwg-pfad))
        (setq ergebnis
          (vl-catch-all-apply
            (function
              (lambda ( / stat)
                (if bereits-offen
                  (progn
                    (vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
                    (setq stat (iad-sync-attribs-in-current-doc attribs ersetzen))
                  )
                  (progn
                    (command "_.OPEN" dwg-pfad)
                    (setq stat (iad-sync-attribs-in-current-doc attribs ersetzen))
                  )
                )
                (if (iad-stat-geaendert stat)
                  (command "_.QSAVE")
                  (princ "\n    (keine Aenderungen, DWG nicht gespeichert)")
                )
                (if (not bereits-offen) (command "_.CLOSE"))
                stat
              )
            )
            nil
          )
        )
        (if (vl-catch-all-error-p ergebnis)
          (progn
            (princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: "
                           (vl-catch-all-error-message ergebnis)))
            (setq anzahl-fehler (1+ anzahl-fehler))
          )
          (progn
            (setq summe-neu       (+ summe-neu       (nth 0 ergebnis))
                  summe-gesetzt   (+ summe-gesetzt   (nth 1 ergebnis))
                  summe-geloescht (+ summe-geloescht (nth 2 ergebnis))
            )
            (if (iad-stat-geaendert ergebnis)
              (setq anzahl-aktualisiert (1+ anzahl-aktualisiert))
              (setq anzahl-unveraendert (1+ anzahl-unveraendert))
            )
          )
        )
      )
    )
  )

  (vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)

  (princ (strcat "\n[ATTR-SYNC] Fertig (Modus " (if ersetzen "Ersetzen" "Ergaenzen") "): "
                 (itoa anzahl-aktualisiert) " DWG(s) aktualisiert, "
                 (itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), "
                 (itoa anzahl-fehler) " Fehler, "
                 (itoa anzahl-fehlt) " nicht gefunden."))
  (princ (strcat "\n[ATTR-SYNC] Attribute: " (itoa summe-neu) " neu angelegt, "
                 (itoa summe-gesetzt) " Werte gesetzt, "
                 (itoa summe-geloescht) " geloescht."))
  (if fehlende-liste
    (progn
      (princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:")
      (foreach name (reverse fehlende-liste)
        (princ (strcat "\n    - " name))
      )
    )
  )
  (princ)
)

;; ------------------------------------------------------------
;; Kernablauf: JSON aus DXFM_DATA/ils lesen und abarbeiten
;; ------------------------------------------------------------
(defun ils-attr-sync-run (ersetzen / data-dir json-pfad dwg-dir daten)
  (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))

  (setq dwg-dir   (strcat data-dir "/ils")
        json-pfad (strcat dwg-dir "/allocations.json")
  )
  (if (not (findfile json-pfad))
    (progn
      (alert (strcat "JSON nicht gefunden:\n" json-pfad))
      (exit)
    )
  )

  (setq daten (ssg-cfg-parse-nested (ssg-read-file-lines json-pfad)))
  (if (not daten)
    (progn
      (alert "JSON konnte nicht gelesen werden oder ist leer.")
      (exit)
    )
  )

  (if (and ersetzen (not (iad-ersetzen-bestaetigt (length daten))))
    (princ "\n[ATTR-SYNC] Abgebrochen - keine Aenderungen.")
    (ils-attr-sync-eintraege daten dwg-dir ersetzen)
  )
  (princ)
)

;; ------------------------------------------------------------
;; Hauptbefehl - Modus wird interaktiv abgefragt
;; (Grossbuchstaben in initget = zulaessige Abkuerzungen: ERG / ERS)
;; ------------------------------------------------------------
(defun c:ILS_ATTR_SYNC ( / modus)
  (initget "ERGaenzen ERSetzen")
  (setq modus (getkword "\nModus waehlen [ERGaenzen/ERSetzen] <ERGaenzen>: "))
  (if (not modus) (setq modus "ERGaenzen"))
  (ils-attr-sync-run (= modus "ERSetzen"))
)

;; ------------------------------------------------------------
;; Direktbefehl fuer den Modus "Ersetzen" (Sicherheitsfrage bleibt)
;; ------------------------------------------------------------
(defun c:ILS_ATTR_REPLACE ()
  (ils-attr-sync-run T)
)

(princ "\naddattribute.lisp geladen. Befehle: ILS_ATTR_SYNC, ILS_ATTR_REPLACE")
(princ)