;;; ============================================================
;;; count_sep_scan.lsp  -  Separator-/Scanner-Zuordnung
;;; ------------------------------------------------------------
;;; Zaehlt die manuell platzierten Bloecke "Scanner" und
;;; "Separator_SP" (Muster siehe cfg/export.cfg [blockpattern]
;;; pattern_scanner/pattern_separator) je Carrier (Kreisel/Eckrad,
;;; VarioFoerderer-Streckengruppe VF_*, Gefaellestrecke GF_* -
;;; Muster pattern_kreisel/pattern_variofoerderer/
;;; pattern_gefaellestrecke) und schreibt die Anzahlen in die
;;; Attribute ANZAHL_SCANNER/ANZAHL_SEPARATOR des jeweiligen
;;; Carrier-Blocks.
;;;
;;; WICHTIG: Gezaehlt werden ausschliesslich die eigenstaendig
;;; platzierten Sensor-Symbole. Der intern in der GF/VF-Kette
;;; gezeichnete 300-mm-Block Staustrecke_Separator_SP ist nur ein
;;; Ketten-/Uebergabestueck (kein eigenstaendiger Separator) und wird
;;; NICHT mitgezaehlt - wer einen Separator gezaehlt haben will, setzt
;;; ein Separator_SP/S-LP-Symbol.
;;;
;;; Zuordnung eines Sensors zu einem Carrier (Z wird ignoriert):
;;;   0. Die Zuordnung wird bei jedem Lauf rein GEOMETRISCH neu
;;;      bestimmt (Schritte 1-4). Ein bereits gesetztes ZUORDNUNG-
;;;      Attribut wird NICHT mehr blind vertraut: stimmt es mit dem
;;;      geometrischen Ergebnis ueberein, bleibt es unveraendert;
;;;      weicht es ab (eingefrorene Fehl-Zuordnung, nachtraeglich
;;;      verschobener Sensor oder ID eines nicht mehr existierenden
;;;      Carriers), wird es ueberschrieben und die Korrektur in
;;;      *cs-korrekturen* vermerkt (Konsolen-Report, siehe
;;;      sens-korrektur-*). Frueher blieb eine einmal geschriebene
;;;      falsche ZUORDNUNG dauerhaft "kleben" und wurde weiter
;;;      mitgezaehlt - das ist behoben.
;;;   1. Scanner: der Einfuegepunkt (X/Y) muss in der Bounding-Box
;;;      des Carriers liegen. Die 3D-Geometrie des Scanners kann
;;;      weit vom Einfuegepunkt entfernt sein, daher zaehlt hier der
;;;      Einfuegepunkt (dort klickt der Benutzer auf den Block).
;;;   2. Separator: der geometrische Mittelpunkt (Zentrum der eigenen
;;;      Bounding-Box, unabhaengig vom $INSBASE) muss in der
;;;      Bounding-Box des Carriers liegen.
;;;   3. Liegt der Punkt in mehreren Boxen (Ueberlappung), wird der
;;;      Carrier mit dem naechstgelegenen Box-Zentrum gewaehlt.
;;;   4. Liegt der Punkt in KEINER Carrier-Box (Scanner koennen
;;;      durchaus ausserhalb der Kreisel-BBox montiert sein), wird der
;;;      raeumlich naechstgelegene Carrier ueber alle Kreisel/Strecken
;;;      hinweg gewaehlt (cs-nearest-two). Ist der Abstand zum
;;;      zweitnaechsten Carrier fast gleich gross (Differenz <=
;;;      cs-strittig-diff-mm, siehe cfg/export.cfg [Sensorzuordnung]
;;;      strittig_diff_mm), gilt die Zuordnung als "strittig": sie
;;;      wird trotzdem geschrieben, aber zusaetzlich in
;;;      *cs-scanner-ergaenzt* (Report-Liste) und
;;;      *cs-scanner-warnung-by-handle* (Key = Entity-Handle, Wert =
;;;      Warnungstext) vermerkt. csv:block-to-json (export.lsp) liest
;;;      *cs-scanner-warnung-by-handle* aus und haengt den Text als
;;;      "warnung"-Feld an den JSON-Block des betroffenen Scanners an
;;;      - export_csv.py gibt ihn in der CSV-Spalte "Warnungen" aus.
;;;      *cs-scanner-ergaenzt* sammelt ALLE per Abstand (nicht per
;;;      BBox) zugeordneten Scanner, nicht nur die strittigen -
;;;      cs-zuordnung-lauf gibt diese Liste auf der Konsole aus.
;;;   5. Ein optionaler Toleranzrand (cs-senstol, siehe
;;;      cfg/export.cfg [Sensorzuordnung] senstol_mm) vergroessert die
;;;      Box, damit Sensoren knapp am Rand noch erfasst werden.
;;;   6. Bei zugeordneten Sensoren wird die ID des Carriers (Attribut
;;;      "ID") in das Sensor-Attribut ZUORDNUNG geschrieben.
;;;   7. Sensoren, zu denen ueberhaupt kein Carrier existiert (leere
;;;      Zeichnung), werden mit einem Kreis auf dem Layer *mark-layer*
;;;      markiert (zentriert auf den Sensor).
;;;
;;; cs-zuordnung-lauf ist die wiederverwendbare Engine (siehe unten):
;;; sie wird sowohl vom interaktiven Befehl ZAEHLE_SEP_SCAN als auch
;;; automatisch vor jedem CSV-/Sivas-Export aufgerufen (Lisp/export.lsp,
;;; csv:run-export) - dort OHNE QSAVE und ohne die ausfuehrliche
;;; Detailzeile je Carrier (verbose=nil), damit die Konsolenausgabe
;;; beim normalen Export kompakt bleibt.
;;;
;;; Aufruf (interaktiv):  ZAEHLE_SEP_SCAN
;;; Laden:                per APPLOAD oder (ssg-ensure "count_sep_scan")
;;; ============================================================

(vl-load-com)

;;; ------------------------------------------------------------
;;; KONFIGURATION
;;; ------------------------------------------------------------

;; Toleranzrand um die Carrier-Box in Zeichnungseinheiten (mm), aus
;; cfg/export.cfg [Sensorzuordnung] senstol_mm (Default 0.0 = exakte
;; Box). Wird von cs-zuordnung-lauf bei jedem Lauf frisch gelesen und
;; hier nur mit einem Startwert vorbelegt, damit cs-in-box/cs-grid-add
;; auch ausserhalb eines Laufs referenzierbar bleiben.
(if (null *senstol*) (setq *senstol* 0.0))

;; Attribut-Tag im Scanner-/Separator-Block, in das die ID des
;; zugeordneten Carriers geschrieben wird.
(setq *zuordnung-tag* "ZUORDNUNG")

;; Markierung von Sensoren ohne jeglichen Carrier: Kreis auf eigenem Layer.
(setq *mark-layer* "S_SENSOR_UNZUGEORDNET")
(setq *mark-color* 2)  ;; 2 = Gelb
;; Kreisradius = Faktor * halbe XY-Diagonale der Sensor-Box,
;; mindestens *mark-radius-min* (mm).
(if (null *mark-radius-factor*) (setq *mark-radius-factor* 1.5))
(if (null *mark-radius-min*)    (setq *mark-radius-min* 500.0))

;; --- Toleranzrand (mm) aus cfg/export.cfg [Sensorzuordnung] senstol_mm ---
(defun cs-senstol ()
  (atof (export:cfg "Sensorzuordnung" "senstol_mm" "0"))
)

;; --- "Strittig"-Schwelle (mm) aus cfg/export.cfg [Sensorzuordnung] ---
;; Differenz zwischen dem Abstand zum naechsten und zweitnaechsten
;; Carrier, unterhalb derer eine Distanz-Zuordnung als unsicher gilt.
(defun cs-strittig-diff-mm ()
  (atof (export:cfg "Sensorzuordnung" "strittig_diff_mm" "500"))
)

;;; ------------------------------------------------------------
;;; Carrier-/Sensor-Erkennung ueber die gemeinsamen Muster aus
;;; cfg/export.cfg [blockpattern] (export:pattern, siehe export.lsp) -
;;; dieselben Muster wie csv:collect-export-blocks/export_csv.py.
;;; ------------------------------------------------------------

;; --- Ist nm ein Kreisel/Eckrad-, VarioFoerderer- oder Gefaellestrecke-
;;     Compound-Block? Alle drei fuehren einheitlich die Attribute
;;     ANZAHL_SCANNER/ANZAHL_SEPARATOR. ---
(defun cs-carrier-p (nm / up)
  (setq up (strcase nm))
  (or (wcmatch up (export:pattern "pattern_kreisel" "KR_*,KREISEL_*,ECKRAD_*"))
      (wcmatch up (export:pattern "pattern_variofoerderer" "VF_*"))
      (wcmatch up (export:pattern "pattern_gefaellestrecke" "GF_*"))
  )
)

;;; ------------------------------------------------------------
;;; Sensor-Erkennung
;;;   Rueckgabe: 'scanner | 'separator | nil
;;; ------------------------------------------------------------
(defun cs-sensor-kind (nm / up)
  (setq up (strcase nm))
  (cond
    ((wcmatch up (strcase (export:pattern "pattern_scanner" "Scanner*")))   'scanner)
    ((wcmatch up (strcase (export:pattern "pattern_separator" "Separator_SP*,S-LP*"))) 'separator)
    (t nil)
  )
)

;;; ------------------------------------------------------------
;;; Bounding-Box eines INSERT holen (WCS, achsparallel).
;;;   Erzwingt vorher ein vla-update (Regen des Objekts), da
;;;   vla-getboundingbox sonst auf nicht-regenerierten oder auf
;;;   eingefrorenen Layern liegenden Bloecken scheitert.
;;;   Rueckgabe: (minx miny maxx maxy)  oder nil bei Fehler.
;;;   *cs-last-error* enthaelt bei Fehler den echten COM-Fehlertext.
;;; ------------------------------------------------------------
(defun cs-pt->list (v)
  (cond
    ((= (type v) 'variant)   (vlax-safearray->list (vlax-variant-value v)))
    ((= (type v) 'safearray) (vlax-safearray->list v))
    ((listp v)               v)
    (t                       nil)
  )
)

(defun cs-bbox (ent / obj res)
  (setq *cs-last-error* nil)
  (setq obj (vlax-ename->vla-object ent))
  ;; Objekt regenerieren (Fehler ignorieren)
  (vl-catch-all-apply 'vla-update (list obj))
  (setq res
    (vl-catch-all-apply
      '(lambda ( / ll ur)
         (vla-getboundingbox obj 'll 'ur)
         (list (cs-pt->list ll) (cs-pt->list ur)))))
  (if (vl-catch-all-error-p res)
    (progn
      (setq *cs-last-error* (vl-catch-all-error-message res))
      nil)
    (list (car  (car res)) (cadr (car res))    ;; minx miny
          (car  (cadr res)) (cadr (cadr res))) ;; maxx maxy
  )
)

;;; ------------------------------------------------------------
;;; Referenzpunkt eines Sensors (X/Y), je nach Typ:
;;;   - Scanner   : Einfuegepunkt (DXF-Gruppe 10).
;;;   - Separator : geometrischer Mittelpunkt seiner eigenen
;;;                 Bounding-Box (unabhaengig vom $INSBASE),
;;;                 Fallback auf den Einfuegepunkt.
;;; ------------------------------------------------------------
(defun cs-sensor-point (ent ed kind / bb)
  (if (eq kind 'scanner)
    (cdr (assoc 10 ed))
    (progn
      (setq bb (cs-bbox ent))
      (if bb
        (list (/ (+ (nth 0 bb) (nth 2 bb)) 2.0)
              (/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
        (cdr (assoc 10 ed))
      )
    )
  )
)

;;; ------------------------------------------------------------
;;; Liegt Punkt pt (X/Y) in Carrier-Record rec (mit Toleranz)?
;;;   rec = (ename tagScan tagSep minx miny maxx maxy cx cy id)
;;; ------------------------------------------------------------
(defun cs-in-box (pt rec / x y)
  (setq x (car pt) y (cadr pt))
  (and (>= x (- (nth 3 rec) *senstol*))
       (<= x (+ (nth 5 rec) *senstol*))
       (>= y (- (nth 4 rec) *senstol*))
       (<= y (+ (nth 6 rec) *senstol*)))
)

;;; ------------------------------------------------------------
;;; Raeumliches Grid (Vorsortierung nach Zellen) ueber die
;;; Carrier-Boxen, damit cs-assign nicht mehr linear ueber ALLE
;;; Carrier laufen muss, sondern nur ueber die Kandidaten der
;;; eigenen Zelle. Aufloesung ~ sqrt(Anzahl Carrier).
;;;   Ein Carrier wird in JEDE Zelle eingetragen, die seine
;;;   (toleranzerweiterte) Box beruehrt - dadurch kann kein
;;;   Treffer verloren gehen (kein false negative), die exakte
;;;   Pruefung (cs-in-box) bleibt unveraendert auf den Kandidaten.
;;;   Rueckgabe von cs-grid-build: (gxmin gymin cellw cellh gridn buckets)
;;;   buckets: Assoc-Liste (zellindex . (rec rec ...))
;;; ------------------------------------------------------------
(defun cs-grid-cellidx (val minv cellsize gridn / idx)
  (setq idx (fix (/ (- val minv) cellsize)))
  (cond ((< idx 0) 0) ((> idx (1- gridn)) (1- gridn)) (t idx))
)

(defun cs-grid-bump (buckets key rec / pair)
  (setq pair (assoc key buckets))
  (if pair
    (subst (cons key (cons rec (cdr pair))) pair buckets)
    (cons (cons key (list rec)) buckets))
)

(defun cs-grid-add (buckets rec gxmin gymin cellw cellh gridn / cx0 cx1 cy0 cy1 cx cy)
  (setq cx0 (cs-grid-cellidx (- (nth 3 rec) *senstol*) gxmin cellw gridn))
  (setq cx1 (cs-grid-cellidx (+ (nth 5 rec) *senstol*) gxmin cellw gridn))
  (setq cy0 (cs-grid-cellidx (- (nth 4 rec) *senstol*) gymin cellh gridn))
  (setq cy1 (cs-grid-cellidx (+ (nth 6 rec) *senstol*) gymin cellh gridn))
  (setq cy cy0)
  (while (<= cy cy1)
    (setq cx cx0)
    (while (<= cx cx1)
      (setq buckets (cs-grid-bump buckets (+ (* cx gridn) cy) rec))
      (setq cx (1+ cx))
    )
    (setq cy (1+ cy))
  )
  buckets
)

(defun cs-grid-build (carriers / n gridn gxmin gymin gxmax gymax cellw cellh buckets)
  (setq n (length carriers))
  (if (= n 0)
    (list 0.0 0.0 1.0 1.0 1 nil)
    (progn
      (setq gxmin (- (nth 3 (car carriers)) *senstol*)
            gymin (- (nth 4 (car carriers)) *senstol*)
            gxmax (+ (nth 5 (car carriers)) *senstol*)
            gymax (+ (nth 6 (car carriers)) *senstol*))
      (foreach rec (cdr carriers)
        (if (< (- (nth 3 rec) *senstol*) gxmin) (setq gxmin (- (nth 3 rec) *senstol*)))
        (if (< (- (nth 4 rec) *senstol*) gymin) (setq gymin (- (nth 4 rec) *senstol*)))
        (if (> (+ (nth 5 rec) *senstol*) gxmax) (setq gxmax (+ (nth 5 rec) *senstol*)))
        (if (> (+ (nth 6 rec) *senstol*) gymax) (setq gymax (+ (nth 6 rec) *senstol*)))
      )
      (setq gridn (max 1 (fix (sqrt n))))
      (setq cellw (/ (max 1.0 (- gxmax gxmin)) gridn))
      (setq cellh (/ (max 1.0 (- gymax gymin)) gridn))
      (setq buckets nil)
      (foreach rec carriers
        (setq buckets (cs-grid-add buckets rec gxmin gymin cellw cellh gridn)))
      (list gxmin gymin cellw cellh gridn buckets)
    )
  )
)

(defun cs-grid-candidates (grid pt / gxmin gymin cellw cellh gridn buckets cx cy pair)
  (setq gxmin (nth 0 grid) gymin (nth 1 grid)
        cellw (nth 2 grid) cellh (nth 3 grid)
        gridn (nth 4 grid) buckets (nth 5 grid))
  (setq cx (cs-grid-cellidx (car pt)  gxmin cellw gridn))
  (setq cy (cs-grid-cellidx (cadr pt) gymin cellh gridn))
  (setq pair (assoc (+ (* cx gridn) cy) buckets))
  (if pair (cdr pair) nil)
)

;;; ------------------------------------------------------------
;;; Sensor-Punkt einem Carrier per BBox zuordnen (Schritt 1-3 oben).
;;;   Rueckgabe: Carrier-Record oder nil (kein BBox-Treffer).
;;;   Bei mehreren Treffern: naechstes Box-Zentrum (X/Y).
;;;   grid = Vorsortierung aus cs-grid-build (statt aller Carrier
;;;   wird nur die Kandidatenliste der eigenen Zelle geprueft).
;;; ------------------------------------------------------------
(defun cs-assign (pt grid / matches best bestd d rec)
  (setq matches nil)
  (foreach rec (cs-grid-candidates grid pt)
    (if (cs-in-box pt rec) (setq matches (cons rec matches))))
  (cond
    ((null matches) nil)
    ((= (length matches) 1) (car matches))
    (t
      (setq best nil bestd nil)
      (foreach rec matches
        (setq d (distance (list (car pt) (cadr pt))
                          (list (nth 7 rec) (nth 8 rec))))
        (if (or (null bestd) (< d bestd))
          (setq bestd d  best rec)))
      best)
  )
)

;;; ------------------------------------------------------------
;;; Die beiden dem Punkt pt (X/Y) naechstgelegenen Carrier, sortiert
;;; nach Abstand zum Box-Mittelpunkt (gleicher Massstab wie der
;;; Ueberlappungs-Tiebreak in cs-assign). carriers darf nicht leer
;;; sein - siehe cs-resolve-sensor.
;;;   Rueckgabe: (best-rec best-dist second-rec-oder-nil second-dist-oder-nil)
;;; ------------------------------------------------------------
(defun cs-nearest-two (pt carriers / paare sortiert rec)
  (setq paare nil)
  (foreach rec carriers
    (setq paare (cons (cons (distance (list (car pt) (cadr pt))
                                      (list (nth 7 rec) (nth 8 rec)))
                            rec)
                      paare))
  )
  (setq sortiert (vl-sort paare (function (lambda (a b) (< (car a) (car b))))))
  (list
    (cdr (nth 0 sortiert))
    (car (nth 0 sortiert))
    (if (cdr sortiert) (cdr (nth 1 sortiert)) nil)
    (if (cdr sortiert) (car (nth 1 sortiert)) nil)
  )
)

;;; ------------------------------------------------------------
;;; Ordnet einen Sensor-Punkt (Scanner oder Separator) rein
;;; GEOMETRISCH einem Carrier zu (Reihenfolge siehe Datei-Kopf-
;;; kommentar Schritte 1-3 = BBox, Schritt 4 = naechster Carrier).
;;; Ein bereits am Sensor stehendes ZUORDNUNG-Attribut geht hier
;;; bewusst NICHT mehr ein - der Vergleich Alt/Neu und das
;;; Ueberschreiben abweichender Werte passiert in cs-zuordnung-lauf
;;; (Schritt 0 im Kopfkommentar). Dadurch heilt eine einmal falsch
;;; gesetzte oder verwaiste ZUORDNUNG bei jedem Lauf selbst aus.
;;;   Rueckgabe: (modus rec best-d second-rec second-d)
;;;   modus = 'bbox | 'distance | 'none (keine Carrier vorhanden)
;;;   best-d/second-rec/second-d sind nur bei modus='distance gesetzt.
;;; ------------------------------------------------------------
(defun cs-resolve-sensor (spt carriers grid / rec nearest)
  (cond
    ((setq rec (cs-assign spt grid))
     (list 'bbox rec nil nil nil))
    ((null carriers)
     (list 'none nil nil nil nil))
    (t
     (setq nearest (cs-nearest-two spt carriers))
     (list 'distance (nth 0 nearest) (nth 1 nearest) (nth 2 nearest) (nth 3 nearest)))
  )
)

;;; ------------------------------------------------------------
;;; Zaehler in einer Assoc-Liste (Schluessel = ename) erhoehen.
;;; ------------------------------------------------------------
(defun cs-bump (alist key / pair)
  (setq pair (assoc key alist))
  (if pair
    (subst (cons key (1+ (cdr pair))) pair alist)
    (cons (cons key 1) alist))
)

;;; ------------------------------------------------------------
;;; Attributwert an einem INSERT setzen (Tag ohne Gross/Klein).
;;;   Rueckgabe: T wenn Tag gefunden und gesetzt, sonst nil.
;;; ------------------------------------------------------------
(defun cs-set-att (ins tag val / e ed done ok)
  (setq done nil ok nil)
  ;; Nur iterieren, wenn der INSERT ueberhaupt Attribute fuehrt (66=1),
  ;; sonst wuerde entnext in fremde Objekte weiterlaufen.
  (if (= (cdr (assoc 66 (entget ins))) 1)
    (progn
      (setq e (entnext ins))
      (while (and e (not done))
        (setq ed (entget e))
        (cond
          ((= (cdr (assoc 0 ed)) "ATTRIB")
            (if (= (strcase (cdr (assoc 2 ed))) (strcase tag))
              (progn
                (entmod (subst (cons 1 val) (assoc 1 ed) ed))
                (entupd e)
                (setq ok t))))
          ((= (cdr (assoc 0 ed)) "SEQEND") (setq done t))
        )
        (setq e (entnext e))
      )
    )
  )
  ok
)

;;; ------------------------------------------------------------
;;; Attributwert (String) an einem INSERT lesen. "" wenn nicht
;;; vorhanden. Tag ohne Gross/Klein-Unterscheidung.
;;; ------------------------------------------------------------
(defun cs-get-att-str (ins tag / e ed done val)
  (setq done nil val "")
  (if (= (cdr (assoc 66 (entget ins))) 1)
    (progn
      (setq e (entnext ins))
      (while (and e (not done))
        (setq ed (entget e))
        (cond
          ((= (cdr (assoc 0 ed)) "ATTRIB")
            (if (= (strcase (cdr (assoc 2 ed))) (strcase tag))
              (progn (setq val (cdr (assoc 1 ed))) (setq done t))))
          ((= (cdr (assoc 0 ed)) "SEQEND") (setq done t))
        )
        (setq e (entnext e))
      )
    )
  )
  val
)

;;; ------------------------------------------------------------
;;; Bezeichnung eines Carriers ermitteln: Attribut "Bezeichnung",
;;; Fallback auf den Blocknamen. Nur fuer Konsolen-/Fehlermeldungen -
;;; die eigentliche Verknuepfung (ZUORDNUNG) laeuft ueber die ID.
;;; ------------------------------------------------------------
(defun cs-carrier-label (ent nm / bez)
  (setq bez (cs-get-att-str ent "Bezeichnung"))
  (if (and bez (/= bez "")) bez nm)
)

;;; ------------------------------------------------------------
;;; Layer anlegen (falls fehlend), ohne den aktuellen Layer zu aendern.
;;; ------------------------------------------------------------
(defun cs-ensure-layer (name color / lay ed)
  (if (tblsearch "LAYER" name)
    ;; Layer existiert bereits: Standardfarbe angleichen
    (progn
      (setq lay (tblobjname "LAYER" name))
      (setq ed  (entget lay))
      (if (assoc 62 ed)
        (entmod (subst (cons 62 color) (assoc 62 ed) ed)))
    )
    ;; Layer neu anlegen
    (entmake (list '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   (cons 2 name)
                   (cons 70 0)
                   (cons 62 color)
                   (cons 6 "Continuous")))
  )
)

;;; ------------------------------------------------------------
;;; Sensor ohne jeglichen Carrier mit einem Kreis markieren, zentriert
;;; auf die Sensor-Geometrie. Radius aus der XY-Box des Sensors
;;; (Faktor), mindestens *mark-radius-min*.
;;; ------------------------------------------------------------
(defun cs-mark-unassigned (ent / bb ipt cx cy cz r)
  (setq bb  (cs-bbox ent))
  (setq ipt (cdr (assoc 10 (entget ent))))
  (setq cz  (if (and ipt (caddr ipt)) (caddr ipt) 0.0))
  (if bb
    (progn
      (setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0)
            cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
      (setq r (* *mark-radius-factor*
                 (/ (distance (list (nth 0 bb) (nth 1 bb))
                              (list (nth 2 bb) (nth 3 bb))) 2.0)))
      (if (< r *mark-radius-min*) (setq r *mark-radius-min*)))
    (progn
      (setq cx (car ipt) cy (cadr ipt) r *mark-radius-min*))
  )
  (cs-ensure-layer *mark-layer* *mark-color*)
  (entmake (list '(0 . "CIRCLE")
                 (cons 8 *mark-layer*)
                 (cons 10 (list cx cy cz))
                 (cons 40 r)))
)

;;; ------------------------------------------------------------
;;; Schnelltest: Ist ein vollstaendiger cs-zuordnung-lauf ueberhaupt
;;; noetig? Der eigentliche Lauf ist teuer (vla-getboundingbox + Regen
;;; je Carrier UND je Sensor). Diese Vorpruefung kommt ohne jede
;;; Bounding-Box aus - sie liest nur Attribute (entget).
;;;
;;; Rueckgabe T (Lauf noetig), wenn EINE der Bedingungen zutrifft:
;;;   a) Ein Scanner-/Separator-Symbol hat ein leeres ZUORDNUNG-Attribut
;;;      (noch nicht zugeordnet) oder ein ZUORDNUNG, das auf keinen
;;;      (mehr) existierenden Carrier zeigt.
;;;   b) An einem Carrier passt ANZAHL_SCANNER nicht zur Anzahl der ihm
;;;      per ZUORDNUNG zugeschriebenen Scanner-Symbole.
;;;   c) An einem Carrier passt ANZAHL_SEPARATOR nicht zur Anzahl der ihm
;;;      per ZUORDNUNG zugeschriebenen Separator-Symbole (nur platzierte
;;;      Symbole zaehlen - dieselbe Regel wie newP im eigentlichen Lauf;
;;;      der interne Staustrecke_Separator_SP zaehlt nicht mit).
;;; Sonst nil - die gespeicherten Attribute sind konsistent, der teure
;;; Lauf wird uebersprungen.
;;;
;;; Die Zuordnung Symbol->Carrier wird hier billig ueber das bereits
;;; gesetzte ZUORDNUNG-Attribut rekonstruiert (Carrier-ID), OHNE die
;;; teure Boundingbox-/Distanz-Rechnung des eigentlichen Laufs. Dadurch
;;; erkennt der Test - anders als eine reine Gesamtsummen-Pruefung - auch
;;; das Verschieben eines Sensors von einem Carrier zu einem anderen
;;; (die Per-Carrier-Zahl kippt, ZUORDNUNG zeigt aber noch auf den alten).
;;; ------------------------------------------------------------
(defun cs-zuordnung-noetig-p ( / ss i ent ed nm sk zuord id
                                carriers carrier-ids sensors s
                                sepByCarrier scanByCarrier
                                noetig expScan expSep rec)
  (setq noetig nil carriers nil carrier-ids nil sensors nil
        sepByCarrier nil scanByCarrier nil)
  (setq ss (ssget "_X" '((0 . "INSERT"))))
  (if (null ss)
    nil   ;; keine Bloecke -> nichts zu tun
    (progn
      ;; Pass 1: Carrier (ename . id) und Sensor-Symbole (kind . ZUORDNUNG)
      ;; sammeln - die ssget-Reihenfolge ist beliebig, daher erst sammeln,
      ;; dann auswerten.
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i) ed (entget ent) nm (cdr (assoc 2 ed)))
        (cond
          ((cs-carrier-p nm)
           (setq id (cs-get-att-str ent "ID"))
           (setq carriers (cons (cons ent id) carriers))
           (setq carrier-ids (cons id carrier-ids)))
          (t
           (setq sk (cs-sensor-kind nm))
           (if sk
             (setq sensors
               (cons (cons sk (cs-get-att-str ent *zuordnung-tag*)) sensors))))
        )
        (setq i (1+ i))
      )
      ;; Pass 2: Symbole ueber ZUORDNUNG je Carrier-ID zaehlen. Leeres
      ;; ZUORDNUNG oder ZUORDNUNG auf einen nicht (mehr) existierenden
      ;; Carrier -> Lauf noetig.
      (foreach s sensors
        (setq sk (car s) zuord (cdr s))
        (cond
          ((or (null zuord) (= zuord ""))     (setq noetig T))
          ((not (member zuord carrier-ids))   (setq noetig T))
          ((eq sk 'scanner) (setq scanByCarrier (cs-bump scanByCarrier zuord)))
          (t                (setq sepByCarrier  (cs-bump sepByCarrier  zuord)))
        )
      )
      ;; Pass 3: je Carrier Soll (= zugeschriebene Symbole) gegen die
      ;; gespeicherten Attribute pruefen.
      (if (not noetig)
        (foreach rec carriers
          (setq id (cdr rec))   ;; rec = (ename . carrier-id)
          (setq expScan (cond ((assoc id scanByCarrier) (cdr (assoc id scanByCarrier))) (t 0)))
          (setq expSep  (cond ((assoc id sepByCarrier)  (cdr (assoc id sepByCarrier)))  (t 0)))
          (if (or (/= (atoi (cs-get-att-str (car rec) "ANZAHL_SCANNER")) expScan)
                  (/= (atoi (cs-get-att-str (car rec) "ANZAHL_SEPARATOR")) expSep))
            (setq noetig T))
        )
      )
      noetig
    )
  )
)

;;; ============================================================
;;; ENGINE - wird sowohl von ZAEHLE_SEP_SCAN als auch automatisch
;;; vor jedem CSV-/Sivas-Export aufgerufen (siehe export.lsp,
;;; csv:run-export).
;;;
;;; label   = Anzeigepraefix fuer die Konsolenausgabe (z.B. "EXPORTCSV").
;;; verbose = T -> zusaetzlich je Carrier eine Detailzeile ausgeben
;;;           (nur fuer den interaktiven Befehl sinnvoll - der
;;;           automatische Aufruf aus csv:run-export laesst dies aus,
;;;           damit die Export-Konsole kompakt bleibt).
;;;
;;; Setzt als Nebenwirkung:
;;;   *cs-scanner-ergaenzt*         - Liste (scanner-id carrier-id
;;;                                   distanz-mm strittig-p
;;;                                   zweiter-carrier-id zweite-distanz-mm)
;;;                                   je per Abstand (nicht per BBox)
;;;                                   zugeordnetem Scanner.
;;;   *cs-scanner-warnung-by-handle* - Assoc-Liste (handle . warnungstext)
;;;                                    fuer strittige Scanner-Zuordnungen,
;;;                                    von csv:block-to-json ausgelesen.
;;;   *cs-korrekturen*              - Liste (typ-wort sensor-id alt-id
;;;                                   neu-id) je Sensor, dessen gespeicherte
;;;                                   ZUORDNUNG nicht zur Geometrie passte
;;;                                   und ueberschrieben wurde (Report).
;;; ============================================================
(defun cs-zuordnung-lauf (label verbose /
                           mss ss i ent ed nm bb cx cy lbl carrier-id
                           carriers grid scanlist seplist sk pt
                           scanCounts sepCounts n-scan-unassigned n-sep-unassigned
                           n-strittig n-zuordnung-fehlt alt
                           s sent spt res mode rec best-d second-rec second-d
                           scanner-id contested handle
                           en nm2 ns nsep newS newP okS okP eintrag)
  (setq carriers nil scanlist nil seplist nil
        n-zuordnung-fehlt 0 n-scan-unassigned 0 n-sep-unassigned 0 n-strittig 0)
  (setq *cs-scanner-ergaenzt* nil)
  (setq *cs-scanner-warnung-by-handle* nil)
  (setq *cs-korrekturen* nil)
  (setq *senstol* (cs-senstol))

  ;; Alte Markierungskreise entfernen (Idempotenz - Sensoren, die in
  ;; einem frueheren Lauf unzuordenbar waren, koennen inzwischen einen
  ;; Carrier bekommen haben oder umgekehrt).
  (setq mss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 *mark-layer*))))
  (if mss (command "_.ERASE" mss ""))
  (vl-catch-all-apply '(lambda () (command "_.REGEN")))

  (princ (ssg-textf "sens-start" (list label)))

  (setq ss (ssget "_X" '((0 . "INSERT"))))
  (if (null ss)
    (princ (ssg-textf "sens-no-inserts" (list label)))
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (setq ed  (entget ent))
        (setq nm  (cdr (assoc 2 ed)))
        (cond
          ((cs-carrier-p nm)
            (setq bb (cs-bbox ent))
            (if bb
              (progn
                (setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0))
                (setq cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
                (setq lbl (cs-carrier-label ent nm))
                (setq carrier-id (cs-get-att-str ent "ID"))
                (setq carriers
                  (cons (list ent "ANZAHL_SCANNER" "ANZAHL_SEPARATOR"
                              (nth 0 bb) (nth 1 bb) (nth 2 bb) (nth 3 bb)
                              cx cy carrier-id lbl)
                        carriers)))
              (princ (ssg-textf "sens-bbox-fehler" (list nm)))
            )
          )
          (t
            (setq sk (cs-sensor-kind nm))
            (if sk
              (progn
                (setq pt (cs-sensor-point ent ed sk))
                (if (eq sk 'scanner)
                  (setq scanlist (cons (list ent pt) scanlist))
                  (setq seplist  (cons (list ent pt) seplist)))))
          )
        )
        (setq i (1+ i))
      )

      (setq grid (cs-grid-build carriers))
      (setq scanCounts nil sepCounts nil)

      ;; --- Scanner zuordnen (inkl. Distanz-Fallback + Strittig-Erkennung) ---
      (foreach s scanlist
        (setq sent (car s) spt (cadr s))
        (setq res  (cs-resolve-sensor spt carriers grid))
        (setq mode (nth 0 res) rec (nth 1 res)
              best-d (nth 2 res) second-rec (nth 3 res) second-d (nth 4 res))
        (cond
          ((eq mode 'none)
           (setq n-scan-unassigned (1+ n-scan-unassigned))
           (cs-mark-unassigned sent))
          ((null rec) nil)  ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
          (t
           (setq scanCounts (cs-bump scanCounts (car rec)))
           ;; Abweichende gespeicherte ZUORDNUNG als Korrektur vermerken,
           ;; bevor sie unten ueberschrieben wird (Selbstheilung eingefrorener
           ;; oder verwaister Zuordnungen).
           (setq alt (cs-get-att-str sent *zuordnung-tag*))
           (if (and alt (/= alt "") (/= alt (nth 9 rec)))
             (setq *cs-korrekturen*
               (cons (list "Scanner" (cs-get-att-str sent "ID") alt (nth 9 rec))
                     *cs-korrekturen*)))
           (if (member mode '(bbox distance))
             (if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
               (setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
           (if (eq mode 'distance)
             (progn
               (setq scanner-id (cs-get-att-str sent "ID"))
               (setq contested (and second-rec
                                    (<= (- second-d best-d) (cs-strittig-diff-mm))))
               (setq *cs-scanner-ergaenzt*
                 (cons (list scanner-id (nth 9 rec) (fix (+ best-d 0.5))
                             contested
                             (if contested (nth 9 second-rec) nil)
                             (if contested (fix (+ second-d 0.5)) nil))
                       *cs-scanner-ergaenzt*))
               (if contested
                 (progn
                   (setq n-strittig (1+ n-strittig))
                   (setq handle (cdr (assoc 5 (entget sent))))
                   (setq *cs-scanner-warnung-by-handle*
                     (cons (cons handle
                                 (strcat "Distanz-Zuordnung unsicher: "
                                         (nth 9 rec) " (" (itoa (fix (+ best-d 0.5))) "mm) vs. "
                                         (nth 9 second-rec) " (" (itoa (fix (+ second-d 0.5))) "mm)"))
                           *cs-scanner-warnung-by-handle*))
                 )
               )
             )
           )
          )
        )
      )
      (setq *cs-scanner-ergaenzt* (reverse *cs-scanner-ergaenzt*))

      ;; --- Separatoren zuordnen (gleiche Logik, ohne Strittig-Report -
      ;;     der Distanz-Fallback stellt hier nur sicher, dass die
      ;;     ANZAHL_SEPARATOR-Summe auch bei Sonderfaellen stimmt). ---
      (foreach s seplist
        (setq sent (car s) spt (cadr s))
        (setq res  (cs-resolve-sensor spt carriers grid))
        (setq mode (nth 0 res) rec (nth 1 res))
        (cond
          ((eq mode 'none)
           (setq n-sep-unassigned (1+ n-sep-unassigned))
           (cs-mark-unassigned sent))
          ((null rec) nil)  ;; Sicherheitsnetz - tritt bei bbox/distance nicht auf
          (t
           (setq sepCounts (cs-bump sepCounts (car rec)))
           (setq alt (cs-get-att-str sent *zuordnung-tag*))
           (if (and alt (/= alt "") (/= alt (nth 9 rec)))
             (setq *cs-korrekturen*
               (cons (list "Separator" (cs-get-att-str sent "ID") alt (nth 9 rec))
                     *cs-korrekturen*)))
           (if (member mode '(bbox distance))
             (if (not (cs-set-att sent *zuordnung-tag* (nth 9 rec)))
               (setq n-zuordnung-fehlt (1+ n-zuordnung-fehlt))))
          )
        )
      )

      ;; --- ANZAHL_SCANNER/ANZAHL_SEPARATOR je Carrier schreiben ---
      (foreach rec carriers
        (setq en   (car rec))
        (setq nm2  (cdr (assoc 2 (entget en))))
        (setq ns   (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
        (setq nsep (cond ((assoc en sepCounts)  (cdr (assoc en sepCounts)))  (t 0)))
        (setq newS ns)
        ;; ANZAHL_SEPARATOR = nur die tatsaechlich platzierten Separator-
        ;; Symbole (Separator_SP/S-LP), die diesem Carrier zugeordnet sind.
        ;; Der intern in der GF/VF-Kette gezeichnete 300-mm-Block
        ;; Staustrecke_Separator_SP ist nur ein Kettenglied (Foerder-/
        ;; Uebergabestueck), KEIN eigenstaendiger Separator - er wird bewusst
        ;; NICHT mitgezaehlt (Entscheidung: nur platzierte Symbole zaehlen).
        (setq newP nsep)
        (setq okS (cs-set-att en (nth 1 rec) (itoa newS)))
        (setq okP (cs-set-att en (nth 2 rec) (itoa newP)))
        (if verbose
          (princ (ssg-textf "sens-carrier-zeile"
                   (list nm2 (nth 9 rec) (itoa newS) (itoa newP)))))
        (if (not (and okS okP))
          (princ (ssg-textf "sens-carrier-fehler" (list nm2))))
      )

      ;; --- Zusammenfassung ---
      (princ (ssg-textf "sens-summary"
               (list label (itoa (length carriers))
                     (itoa (length scanlist)) (itoa n-scan-unassigned)
                     (itoa (length seplist)) (itoa n-sep-unassigned))))

      (if *cs-scanner-ergaenzt*
        (progn
          (princ (ssg-textf "sens-ergaenzt-header"
                   (list label (itoa (length *cs-scanner-ergaenzt*)))))
          (foreach eintrag *cs-scanner-ergaenzt*
            (princ (ssg-textf "sens-ergaenzt-zeile"
                     (list (nth 0 eintrag) (nth 1 eintrag) (itoa (nth 2 eintrag)))))
            (if (nth 3 eintrag)
              (princ (ssg-textf "sens-strittig-suffix"
                       (list (nth 4 eintrag) (itoa (nth 5 eintrag))))))
          )
        )
      )
      (if (> n-strittig 0)
        (princ (ssg-textf "sens-strittig-summary" (list label (itoa n-strittig)))))

      ;; --- Korrigierte (nicht zur Geometrie passende) ZUORDNUNG melden ---
      (if *cs-korrekturen*
        (progn
          (setq *cs-korrekturen* (reverse *cs-korrekturen*))
          (princ (ssg-textf "sens-korrektur-header"
                   (list label (itoa (length *cs-korrekturen*)))))
          (foreach eintrag *cs-korrekturen*
            (princ (ssg-textf "sens-korrektur-zeile"
                     (list (nth 0 eintrag) (nth 1 eintrag)
                           (nth 2 eintrag) (nth 3 eintrag)))))
        )
      )

      (if (> (+ n-scan-unassigned n-sep-unassigned) 0)
        (princ (ssg-textf "sens-unassigned-marked"
                 (list label (itoa (+ n-scan-unassigned n-sep-unassigned)) *mark-layer*))))
      (if (> n-zuordnung-fehlt 0)
        (princ (ssg-textf "sens-zuordnung-fehlt" (list label (itoa n-zuordnung-fehlt)))))
    )
  )
  (princ)
)

;;; ============================================================
;;; BEFEHL: ZAEHLE_SEP_SCAN - interaktiver Aufruf mit vollem Bericht
;;; (verbose) und abschliessendem QSAVE. Der automatische Aufruf vor
;;; jedem CSV-/Sivas-Export (csv:run-export in export.lsp) nutzt
;;; dieselbe Engine (cs-zuordnung-lauf) direkt, ohne QSAVE.
;;; ============================================================
(defun c:ZAEHLE_SEP_SCAN ()
  (cs-zuordnung-lauf "ZAEHLE_SEP_SCAN" T)
  (princ "\n--------------------------------------------")
  (princ "\n  Speichere Zeichnung (QSAVE) ...")
  (command "_.QSAVE")
  (princ "\n>>> Fertig.")
  (princ)
)

(princ "\n>>> count_sep_scan.lsp geladen. Befehl: ZAEHLE_SEP_SCAN")
(princ)