;; ============================================================
;; addattribute.lisp
;; Synchronisiert ATTDEF-Attribute in den ILS-Block-DWGs mit den
;; Werten aus allocations.json.
;;
;; Es wird zwischen data/ils/2D und data/ils/3D unterschieden: nach
;; Auswahl des Verzeichnisses wird die dortige allocations.json
;; gelesen (data/ils/<2D|3D>/allocations.json) und anschliessend
;; werden ausschliesslich die DWGs in genau diesem Verzeichnis
;; bearbeitet.
;;
;; 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.
;;   - DWG nur dann speichern, wenn sich mindestens ein Attributwert
;;     geaendert hat oder neu angelegt 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.
;;
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
;;
;; Aufruf in BricsCAD:
;;   (load "C:/.../data/ils/2D/addattribute.lisp")
;;   ILS_ATTR_SYNC
;; ============================================================

(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
)

;; ------------------------------------------------------------
;; Ein einzelnes ATTDEF aktualisieren (Ueberschreib-Regel)
;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde
;; ------------------------------------------------------------
(defun iad-update-attdef (ent jsonwert / 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 (= (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)"))
)

;; ------------------------------------------------------------
;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
;; attribs = (("TAG" . "Wert") ...)
;; Rueckgabe: t, wenn mindestens ein Attribut geaendert/neu angelegt wurde
;; ------------------------------------------------------------
(defun iad-sync-attribs-in-current-doc (attribs / texthoehe layer ss anzahl i ent ed
                                          tag wert pt vorhandene ypos gefunden paar geaendert)
  (setq texthoehe (ssg-cfg-or "ils_attribut" "texthoehe" 50.0)
        layer     (ssg-cfg-or "ils_attribut" "layer" "0")
        vorhandene nil
        ypos       0.0
        geaendert  nil
  )
  ;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken
  (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))
        )
        (setq vorhandene (cons (cons tag ent) vorhandene))
        (if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt)))
        (setq i (1+ i))
      )
    )
  )
  (setq ypos (- ypos (* texthoehe 2.0)))

  (foreach paar attribs
    (setq tag  (car paar)
          wert (cdr paar)
    )
    (if (null wert) (setq wert ""))
    (setq gefunden (cdr (assoc tag vorhandene)))
    (if gefunden
      (if (iad-update-attdef gefunden wert) (setq geaendert t))
      (progn
        (iad-create-attdef tag wert ypos texthoehe layer)
        (setq ypos (- ypos (* texthoehe 2.0)))
        (setq geaendert t)
      )
    )
  )
  geaendert
)

;; ------------------------------------------------------------
;; Hauptbefehl
;; ------------------------------------------------------------
(defun c:ILS_ATTR_SYNC ( / data-dir json-pfad dwg-dir dwg-unterverz daten orig-doc anzahl-aktualisiert
                          anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag blockname attribs
                          dwg-pfad bereits-offen fehler fehlende-liste name)
  (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))

  (initget "2D 3D")
  (setq dwg-unterverz (getkword "\nDWG-Verzeichnis waehlen [2D/3D] <2D>: "))
  (if (not dwg-unterverz) (setq dwg-unterverz "2D"))
  (setq dwg-dir   (strcat data-dir "/ils/" dwg-unterverz)
        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)
    )
  )

  (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
  )

  (foreach eintrag daten
    (setq blockname (car eintrag)
          attribs   (cdr eintrag)
          dwg-pfad  (strcat dwg-dir "/" blockname ".dwg")
    )
    (if (findfile dwg-pfad)
      (progn
        (princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ..."))
        (setq bereits-offen (iad-find-open-doc dwg-pfad))
        (setq fehler
          (vl-catch-all-apply
            (function
              (lambda ( / geaendert)
                (if bereits-offen
                  (progn
                    (vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
                    (setq geaendert (iad-sync-attribs-in-current-doc attribs))
                  )
                  (progn
                    (command "_.OPEN" dwg-pfad)
                    (setq geaendert (iad-sync-attribs-in-current-doc attribs))
                  )
                )
                (if geaendert
                  (command "_.QSAVE")
                  (princ "\n    (keine Aenderungen, DWG nicht gespeichert)")
                )
                (if (not bereits-offen) (command "_.CLOSE"))
                geaendert
              )
            )
            nil
          )
        )
        (if (vl-catch-all-error-p fehler)
          (progn
            (princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: "
                           (vl-catch-all-error-message fehler)))
            (setq anzahl-fehler (1+ anzahl-fehler))
          )
          (if fehler
            (setq anzahl-aktualisiert (1+ anzahl-aktualisiert))
            (setq anzahl-unveraendert (1+ anzahl-unveraendert))
          )
        )
      )
      (progn
        (setq anzahl-fehlt (1+ anzahl-fehlt))
        (setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste))
      )
    )
  )

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

  (princ (strcat "\n[ATTR-SYNC] Fertig: " (itoa anzahl-aktualisiert) " DWG(s) aktualisiert, "
                 (itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), "
                 (itoa anzahl-fehler) " Fehler, "
                 (itoa anzahl-fehlt) " nicht gefunden."))
  (if fehlende-liste
    (progn
      (princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:")
      (foreach name (reverse fehlende-liste)
        (princ (strcat "\n    - " name))
      )
    )
  )
  (princ)
)

(princ "\naddattribute.lisp geladen. Befehl: ILS_ATTR_SYNC")
(princ)