;; ============================================================
;; SSG_ID - Eindeutige ID-Verwaltung fuer SSG_LIB Bloecke
;;
;; Jedes eingefuegte Element erhaelt ein Attribut "ID" mit
;; einer eindeutigen, vierstelligen Nummer (z.B. "0001").
;;
;; Befehle:
;;   IDGENERATE - Weist dem zuletzt eingefuegten Block eine neue ID zu
;;   IDSCHECK   - Prueft alle Bloecke auf doppelte IDs und korrigiert sie
;;
;; Funktionen:
;;   (ssg-id-max)             - Hoechste ID in der Zeichnung ermitteln
;;   (ssg-id-generate ent)    - Neue ID erzeugen und auf Block setzen
;;   (ssg-id-check-all)       - Doubletten pruefen und korrigieren
;;   (ssg-id-format n)        - Zahl als 4-stelligen String formatieren
;; ============================================================


;; --- ID als 4-stelligen String formatieren ---
;; n = Integer (z.B. 1 -> "0001", 42 -> "0042")
(defun ssg-id-format (n / s)
  (setq s (itoa n))
  (while (< (strlen s) 4)
    (setq s (strcat "0" s))
  )
  s
)


;; --- Alle exportierbaren INSERT-Entities sammeln ---
;; Gleiche Filterlogik wie csv:collect-export-blocks (siehe dort auch
;; pattern_separator/pattern_scanner in cfg/export.cfg - Separator_SP/S-LP/
;; Scanner sind eigenstaendige Sensor-Bloecke, die inzwischen ein eigenes
;; ID-ATTDEF haben und daher hier ebenfalls erfasst werden muessen, sonst
;; bleibt ihr ID-Attribut trotz ATTDEF für immer leer - ssg-attrib-set-on
;; kann nur einen Wert SETZEN, wenn der Block ueberhaupt erst hier landet).
;; BTMT-Beladung*/SC_Entladung* (siehe pattern_btmt_beladung/
;; pattern_btmt_entladung in cfg/export.cfg) aus demselben Grund: sonst bleibt
;; ihre ID trotz ATTDEF leer und sie fehlen bei der zeichnungsweiten Duplikat-
;; pruefung/Maximum-Ermittlung (ssg-id-check-all).
(defun ssg-id-collect-blocks ( / ss-all ss-out i ename ed bname)
  (dbgf "ssg-id-collect-blocks")
  (setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
  (dbgreturn (if (null ss-all)
    nil
    (progn
      (setq ss-out (ssadd))
      (setq i 0)
      (while (setq ename (ssname ss-all i))
        (setq ed (entget ename))
        (setq bname (cdr (assoc 2 ed)))
        (if (or
              (wcmatch bname "KR_*,KREISEL_*,ECKRAD_*")
              (wcmatch (strcase bname) "AP110*,AP_110*,AP60*,AP_60*,APG110*")
              (wcmatch bname "Vario*,Staustrecke*,AUS_Element*,EIN_Element*,VF_*,GF_*")
              (wcmatch bname "Separator_SP*,S-LP*,Scanner*")
              (wcmatch bname "BTMT-Beladung*,SC_Entladung*")
              (wcmatch bname "#*")
            )
          (ssadd ename ss-out)
        )
        (setq i (1+ i))
      )
      (if (= (sslength ss-out) 0) nil ss-out)
    )
  ))
)


;; --- Hoechste bereits vergebene ID in einem Auswahlsatz ermitteln ---
;; ss = Auswahlsatz (i.d.R. aus ssg-id-collect-blocks) oder nil.
;; Rueckgabe: Integer (hoechste ID) oder 0 wenn keine gefunden.
;;
;; Bewusst als eigene Funktion: ssg-id-check-all MUSS diesen Wert ueber den
;; GESAMTEN Auswahlsatz kennen, BEVOR es die erste neue ID vergibt (siehe
;; Phase 0 dort) - sonst haengt die Neuvergabe von der (beliebigen)
;; ssget-Reihenfolge ab und vergibt IDs, die weiter hinten im Auswahlsatz
;; schon belegt sind.
(defun ssg-id-max-in-ss (ss / i ename attribs id-val id-num max-id)
  (setq max-id 0)
  (if ss
    (progn
      (setq i 0)
      (while (setq ename (ssname ss i))
        (setq attribs (ssg-attrib-read ename))
        (setq id-val (cdr (assoc "ID" attribs)))
        (if (and id-val (> (strlen id-val) 0))
          (progn
            (setq id-num (atoi id-val))
            (if (> id-num max-id)
              (setq max-id id-num)
            )
          )
        )
        (setq i (1+ i))
      )
    )
  )
  max-id
)


;; --- Hoechste ID in der Zeichnung ermitteln ---
;; Durchsucht alle exportierbaren Bloecke nach dem Attribut "ID".
;; Rueckgabe: Integer (hoechste ID) oder 0 wenn keine gefunden.
(defun ssg-id-max ( / max-id)
  (dbgf "ssg-id-max")
  (setq max-id (ssg-id-max-in-ss (ssg-id-collect-blocks)))
  (dbgreturn max-id)
)


;; --- Neue ID erzeugen und auf einen Block setzen ---
;; ent = Entity-Name eines INSERT-Blocks mit ID-Attribut
;; Rueckgabe: Die zugewiesene ID als String oder nil bei Fehler
(defun ssg-id-generate (ent / max-id new-id new-id-str)
  (dbgf "ssg-id-generate")
  (dbg 'ent)
  (dbgreturn (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
    (progn
      (setq max-id (ssg-id-max))
      (setq new-id (1+ max-id))
      (setq new-id-str (ssg-id-format new-id))
      (ssg-attrib-set-on ent (list (cons "ID" new-id-str)))
      (princ (ssg-textf "id-new-assigned" (list new-id-str)))
      new-id-str
    )
    (progn
      (princ (ssg-text "id-invalid-block"))
      nil
    )
  ))
)


;; --- ID-Attribut setzen UND sofort verifizieren ---
;; ssg-attrib-set-on kann eine Tag/Wert-Zuweisung STILL VERWERFEN, wenn der
;; INSTANZ-spezifische ATTRIB-Eintrag fuer diesen Tag gar nicht existiert
;; (z.B. bei einer Blockreferenz, die vor dem Hinzufuegen des ID-ATTDEF
;; eingefuegt wurde und seither nicht per ATTSYNC aktualisiert wurde) -
;; ohne Fehlermeldung. Das fuehrt genau zu der Art von "unsichtbarem"
;; doppelten ID-Fehler, der ssg-id-check-all eigentlich verhindern soll:
;; die Funktion GLAUBT, sie habe eine neue ID vergeben, aber am Block
;; steht weiterhin die alte (bzw. gar keine) ID. Diese Hilfsfunktion liest
;; nach dem Setzen sofort zurueck und warnt laut, wenn es nicht geklappt hat.
(defun ssg-id-set-and-verify (ename new-id-str kontext-text / attribs-danach)
  (dbgf "ssg-id-set-and-verify")
  (dbg 'ename)
  (dbg 'new-id-str)
  (dbg 'kontext-text)
  (ssg-attrib-set-on ename (list (cons "ID" new-id-str)))
  (setq attribs-danach (ssg-attrib-read ename))
  (dbgreturn (if (not (equal (cdr (assoc "ID" attribs-danach)) new-id-str))
    (princ (strcat "\n[SSG_ID] WARNUNG: ID=" new-id-str " konnte NICHT auf "
                   (cdr (assoc 2 (entget ename))) " (Handle "
                   (cdr (assoc 5 (entget ename))) ", " kontext-text
                   ") geschrieben werden - Block hat vermutlich kein "
                   "ID-ATTDEF (Attribut-Sync/Redefine noetig)."))
  ))
)

;; --- Alle Bloecke auf doppelte IDs pruefen und korrigieren ---
;; Findet Bloecke mit gleicher ID. Behaelt die erste Instanz,
;; weist Duplikaten neue IDs zu.
;; Rueckgabe: Anzahl korrigierter IDs
(defun ssg-id-check-all ( / ss i ename attribs id-val id-num
                           id-map entry max-id fixed-count new-id-str bname)
  (dbgf "ssg-id-check-all")
  (setq ss (ssg-id-collect-blocks))
  (dbg 'ss)
  (dbgp (strcat "Anzahl erfasster Bloecke: " (if ss (itoa (sslength ss)) "0")))
  (dbgreturn (if (null ss)
    (progn
      (princ (ssg-text "id-check-no-blocks"))
      0
    )
    (progn
      ;; Phase 0: Hoechste BEREITS vergebene ID ueber den GESAMTEN Auswahlsatz
      ;; ermitteln - zwingend VOR der ersten Neuvergabe in Phase 1.
      ;;
      ;; Frueher wurde max-id erst waehrend Phase 1 mitgefuehrt (Start 0) und
      ;; eine fehlende ID sofort mit max-id+1 belegt. Die Reihenfolge von
      ;; (ssget "X" ...) ist aber beliebig - in BricsCAD kommen die zuletzt
      ;; erzeugten Entities zuerst. Genau das trifft die temporaeren
      ;; Separator-Kopien aus csv:sep-proxies-erzeugen (export.lsp): sie haben
      ;; noch keine ID, stehen ganz vorne und bekamen daher 0001, 0002, ... -
      ;; also exakt die IDs, die die weiter hinten liegenden Kreisel/VF_n/GF_n
      ;; laengst tragen. Phase 2 konnte das nicht heilen, weil die frisch
      ;; vergebenen IDs nicht in id-map landen (und auch nicht muessen: sie
      ;; liegen jetzt garantiert oberhalb jeder vorhandenen ID).
      (dbgp "=== Phase 0: hoechste vorhandene ID ermitteln ===")
      (setq max-id (ssg-id-max-in-ss ss))
      (dbgp (strcat "Phase 0: hoechste vorhandene ID = " (itoa max-id)))

      ;; Phase 1: Alle IDs sammeln, Bloecke ohne ID neu nummerieren
      (dbgp "=== Phase 1: IDs sammeln ===")
      (setq id-map nil)
      (setq i 0)
      (while (setq ename (ssname ss i))
        (setq attribs (ssg-attrib-read ename))
        (setq id-val (cdr (assoc "ID" attribs)))
        (setq bname (cdr (assoc 2 (entget ename))))
        (dbgp (strcat "  [" (itoa i) "] " bname " (Handle " (cdr (assoc 5 (entget ename)))
                      ") ID-Attrib-vorhanden=" (if (assoc "ID" attribs) "JA" "NEIN")
                      " id-val=" (if id-val (strcat "\"" id-val "\"") "nil")))
        (if (and id-val (> (strlen id-val) 0))
          (progn
            (setq id-num (atoi id-val))
            ;; max-id NICHT mehr hier nachziehen - es steht seit Phase 0 auf
            ;; dem globalen Maximum und dient ab jetzt nur noch als Zaehler
            ;; fuer die Neuvergabe.
            ;; In Map eintragen: (id-num . (ename1 ename2 ...))
            (setq entry (assoc id-num id-map))
            (if entry
              (progn
                (dbgp (strcat "    ID " id-val " bereits gesehen bei "
                              (itoa (length (cdr entry))) " anderen Block(en) -> DUPLIKAT-KANDIDAT"))
                (setq id-map (subst (cons id-num (append (cdr entry) (list ename)))
                                    entry id-map))
              )
              (setq id-map (cons (cons id-num (list ename)) id-map))
            )
          )
          ;; Block ohne ID -> neue ID zuweisen
          (progn
            (setq max-id (1+ max-id))
            (setq new-id-str (ssg-id-format max-id))
            (dbgp (strcat "    -> keine/leere ID, weise neu zu: " new-id-str))
            (ssg-id-set-and-verify ename new-id-str "Block ohne ID")
            (princ (ssg-textf "id-check-missing-set"
                     (list new-id-str (cdr (assoc 2 (entget ename))))))
          )
        )
        (setq i (1+ i))
      )
      (dbgp (strcat "Phase 1 abgeschlossen: max-id=" (itoa max-id)
                    " id-map hat " (itoa (length id-map)) " unterschiedliche ID-Werte"))
      (foreach entry id-map
        (if (> (length (cdr entry)) 1)
          (dbgp (strcat "  DUPLIKAT ID=" (ssg-id-format (car entry)) ": "
                        (itoa (length (cdr entry))) " Bloecke -> "
                        (apply 'strcat (mapcar
                          '(lambda (e) (strcat (cdr (assoc 2 (entget e))) "(Handle "
                                                (cdr (assoc 5 (entget e))) ") "))
                          (cdr entry)))))
        )
      )

      ;; Phase 2: Duplikate korrigieren
      (dbgp "=== Phase 2: Duplikate korrigieren ===")
      (setq fixed-count 0)
      (foreach entry id-map
        (if (> (length (cdr entry)) 1)
          (progn
            ;; Erste Instanz behalten, Duplikate neu nummerieren
            (dbgp (strcat "ID=" (ssg-id-format (car entry)) ": behalte "
                          (cdr (assoc 2 (entget (car (cdr entry))))) " (Handle "
                          (cdr (assoc 5 (entget (car (cdr entry))))) "), nummeriere "
                          (itoa (1- (length (cdr entry)))) " weitere um"))
            (foreach ename (cdr (cdr entry))
              (setq max-id (1+ max-id))
              (setq new-id-str (ssg-id-format max-id))
              (dbgp (strcat "  " (cdr (assoc 2 (entget ename))) " (Handle "
                            (cdr (assoc 5 (entget ename))) ") ID=" (ssg-id-format (car entry))
                            " -> " new-id-str))
              (ssg-id-set-and-verify ename new-id-str
                (strcat "Duplikat von ID=" (ssg-id-format (car entry))))
              (princ (ssg-textf "id-check-duplicate"
                       (list (ssg-id-format (car entry)) new-id-str
                             (cdr (assoc 2 (entget ename))))))
              (setq fixed-count (1+ fixed-count))
            )
          )
        )
      )
      (dbgp (strcat "Phase 2 abgeschlossen: " (itoa fixed-count) " Duplikate korrigiert"))

      (princ (ssg-textf "id-check-done" (list fixed-count)))
      fixed-count
    )
  ))
)


;; --- Befehl: IDSCHECK ---
;; Prueft alle Bloecke auf doppelte IDs und korrigiert sie.
(defun c:IDSCHECK ( / count)
  (ssg-start "IDSCHECK" nil)
  (setq count (ssg-id-check-all))
  (princ (ssg-textf "id-check-corrected" (list count)))
  (ssg-end)
  (princ)
)

;; --- Befehl: IDGENERATE ---
;; Fordert den Benutzer auf, einen Block zu waehlen und weist eine neue ID zu.
(defun c:IDGENERATE ( / ent ed)
  (ssg-start "IDGENERATE" nil)
  (setq ent (car (entsel (ssg-text "id-select-block-prompt"))))
  (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))
    (ssg-id-generate ent)
    (princ (ssg-text "id-generate-invalid"))
  )
  (ssg-end)
  (princ)
)

(princ "\n[SSG_ID] Geladen.")
(princ)