;; ============================================================
;; SSG_CORE.LSP - Kernbibliothek: Umgebung, Fehler, Dialog
;; Allgemeingueltige Hilfsfunktionen fuer AutoCAD-LISP Makros
;; Ursprung: ACADSST/MENU/ssg.lsp, pu1pu2.lsp (Schoenenberger)
;; Bereinigt und verallgemeinert: 2025
;; ============================================================


;; ------------------------------------------------------------
;; UMGEBUNGSSICHERUNG
;; Sichert Systemvariablen vor Makroausfuehrung und stellt
;; sie danach wieder her. Wird immer als Paar verwendet:
;;   (ssg-start "Titel" '(("OSMODE") ("ORTHOMODE")))
;;   ... Makrocode ...
;;   (ssg-end)
;;
;; Nestbar ueber *ssg-start-stack*: jedes ssg-start legt einen eigenen
;; Frame (vorheriger *error*-Handler + Variablenwerte) oben auf den
;; Stack, ssg-end nimmt genau diesen Frame wieder herunter. Noetig, weil
;; z.B. ein Test-Wrapper (ssg-start "TEST_KREISEL" ...) selbst wieder
;; Makros aufruft, die ihrerseits ssg-start/ssg-end nutzen - mit einer
;; einzelnen globalen Variable statt eines Stacks wuerde der innere
;; Aufruf den *error*-Handler und die CLAYER/CMDECHO/...-Werte des
;; aeusseren Aufrufs ueberschreiben. Ergebnis waere ein *error* wird
;; nach dem aeusseren ssg-end dauerhaft an ssg-errhan haengen bleiben
;; (statt zum urspruenglichen Default-Handler zurueckzukehren) und bei
;; jedem folgenden Fehler faelschlich veraltete CLAYER/CECOLOR-Werte
;; ueber "_LAYER"/"_undo" auf die Kommandozeile schreiben.
;; ------------------------------------------------------------

(if (not (boundp '*ssg-start-stack*)) (setq *ssg-start-stack* nil))

(defun ssg-start (titel zusatz-vars / cavar xlen xpos xvar)
  ;; titel      - Anzeigename des Makros
  ;; zusatz-vars - Liste zusaetzlicher Variablen z.B. '(("OSMODE")("ORTHOMODE"))
  ;;               Immer CLAYER und CMDECHO werden automatisch gesichert.
  (setq cavar (append '(("CLAYER") ("CMDECHO")) zusatz-vars)
        xlen  (length cavar)
        xpos  0
  )
  (repeat xlen
    (setq xvar  (car (nth xpos cavar))
          cavar (subst (cons xvar (getvar xvar)) (nth xpos cavar) cavar)
          xpos  (1+ xpos)
    )
  )
  (setq *ssg-start-stack* (cons (cons *error* cavar) *ssg-start-stack*))
  (setq *error* (function ssg-errhan))
  (setvar "CMDECHO" 0)
  (command "_undo" "_G")
  (graphscr)
  (if titel (prompt (ssg-textf "core-start-titel" (list titel))))
  (princ)
)

(defun ssg-end (/ frame cavar xpos xlen xvar)
  (if *ssg-start-stack*
    (progn
      (setq frame            (car *ssg-start-stack*)
            *ssg-start-stack* (cdr *ssg-start-stack*)
            cavar             (cdr frame)
      )
      (command)
      (command "_undo" "_E")
      (setq xpos 1
            xlen (length cavar)
      )
      (if (/= (getvar "CLAYER") (caar cavar))
        (command "_LAYER" "_SE" (cdar cavar) "")
      )
      (repeat (1- xlen)
        (setq xvar (nth xpos cavar)
              xpos (1+ xpos)
        )
        (setvar (car xvar) (cdr xvar))
      )
      (setq *error* (car frame))
    )
  )
  (princ)
)

(defun ssg-errhan (em)
  (if (= em "Function cancelled")
    (princ)
    (progn (princ (ssg-text "core-errhan-fehler")) (princ em))
  )
  (command)
  (command)
  (ssg-end)
)


;; ------------------------------------------------------------
;; BLOCK-WRAP MIT GARANTIERT WELTPARALLELEM BKS
;; ------------------------------------------------------------
;; Fasst die Entities in ss zu einem Block bname zusammen und fuegt ihn am
;; Welt-Punkt basispkt-welt wieder ein. Setzt das BKS dazu temporaer hart
;; auf Welt und stellt es danach wieder her.
;;
;; Hintergrund (31.95mm-Z-Versatz-Bug): (command "_.-BLOCK"/"_.INSERT" ...)
;; rechnet Punktargumente im AKTUELLEN BKS. Bei einem vom Welt-KS
;; abweichenden BKS ging der korrekt via (trans ...) umgerechnete Z-Wert
;; beim _.-BLOCK -> _.INSERT-Rundlauf verloren, sodass der fertige Block
;; um die BKS-Hoehe (z.B. 31.95mm) in Z verschoben wurde - obwohl die
;; ELEVATION-Systemvariable 0 war. Bei BKS=Welt liegen Objekte, Basispunkt
;; und Einfuegepunkt alle bei WCS-Z ohne jede Umrechnungs-Mehrdeutigkeit;
;; ein bei WCS-Z=0 platziertes Element bleibt garantiert bei Z=0.
;;
;; Rueckgabe: das eingefuegte INSERT-Objekt (entlast).
(defun ssg-block-wrap-welt (bname basispkt-welt ss / alt-attreq alt-attdia alt-elev alt-osmode)
  (setq alt-attreq  (getvar "ATTREQ")
        alt-attdia  (getvar "ATTDIA")
        alt-elev    (getvar "ELEVATION")
        alt-osmode  (getvar "OSMODE"))
  (setvar "ATTREQ" 0)
  (setvar "ATTDIA" 0)
  ;; OSMODE=0: laufenden Objektfang abschalten. Sonst kann _.INSERT den
  ;; explizit uebergebenen Einfuegepunkt (X,Y,0) auf ein an derselben X/Y-Stelle
  ;; liegendes Objekt umfangen - z.B. den gefangenen Basispunkt bei Z=12000 ->
  ;; der Block landet auf 12000 statt 0 (12000er-Bug).
  (setvar "OSMODE" 0)
  ;; ELEVATION=0: sonst kann _.INSERT die Z-Hoehe aus der aktuellen Elevation
  ;; statt aus dem uebergebenen Punkt ziehen.
  (setvar "ELEVATION" 0.0)
  ;; BKS temporaer auf Welt; _Previous stellt danach das vorige BKS wieder her.
  (command "_.UCS" "_World")
  ;; basispkt-welt ist ein Welt-Punkt; bei BKS=Welt ist er zugleich BKS-Punkt.
  (command "_.-BLOCK" bname basispkt-welt ss "")
  (command "_.INSERT" bname basispkt-welt 1.0 1.0 0.0)
  (command "_.UCS" "_Previous")
  (setvar "OSMODE" alt-osmode)
  (setvar "ELEVATION" alt-elev)
  (setvar "ATTREQ" alt-attreq)
  (setvar "ATTDIA" alt-attdia)
  (entlast)
)


;; ------------------------------------------------------------
;; GUI-MODUS (fuer automatische Tests)
;; ------------------------------------------------------------
;; Globaler Schalter, um alle interaktiven Oberflaechen-Abfragen (DCL-Dialoge,
;; Wizard-Fenster) abzuschalten - dann laufen die Module ueber ihre Konsolen-
;; bzw. Nicht-GUI-Pfade, die von den Testrunnern per Mock-Eingabe/Replay
;; bedient werden. Default nil = GUI an (normaler Betrieb).
;; Test-Setup ruft (ssg-gui-aus) auf; ssg-gui-p fragt den Zustand ab.
(if (not (boundp '*ssg-gui-aus*)) (setq *ssg-gui-aus* nil))
(defun ssg-gui-p () (null *ssg-gui-aus*))       ;; T = GUI erlaubt
(defun ssg-gui-aus () (setq *ssg-gui-aus* T) (princ))
(defun ssg-gui-an  () (setq *ssg-gui-aus* nil) (princ))

;; ------------------------------------------------------------
;; LISP-PFAD-ERMITTLUNG
;; ------------------------------------------------------------
;; Zentraler Ersatz fuer den bisher in mehreren Modulen duplizierten
;; 3-stufigen Pfad-cond (DXFM_LISP env -> *ssg-lisp-pfad* vom MNL -> nil).
;; Liefert das Lisp-Verzeichnis (mit "/"-Trennern, ohne abschliessenden "/")
;; oder nil, wenn keine Quelle gesetzt ist.
;;
;; HINWEIS zur Ladeordnung: Diese Funktion lebt in ssg_core.lsp und ist erst
;; verfuegbar, NACHDEM ssg_core geladen wurde. Der ssg_core-Bootstrap selbst
;; (z.B. in VarioFoerderer.lsp/vf_konstanten.lsp/vf_core.lsp, der ssg_core erst
;; laedt) kann sie daher NICHT nutzen - dort bleibt der Inline-cond stehen.
;; Alle Stellen, die garantiert nach dem ssg_core-Laden laufen, nutzen sie.
(defun ssg-lisp-verzeichnis ( / )
  (cond
    ((getenv "DXFM_LISP")
     (vl-string-translate "\\" "/" (getenv "DXFM_LISP")))
    ((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*)
     *ssg-lisp-pfad*)
    (t nil)
  )
)

;; Vollstaendiger Pfad zu einer Lisp-Datei im Lisp-Verzeichnis (oder nil).
;; dateiname z.B. "vf_core.lsp".
(defun ssg-lisp-datei-pfad (dateiname / verz)
  (setq verz (ssg-lisp-verzeichnis))
  (if verz (strcat verz "/" dateiname) nil)
)


;; ------------------------------------------------------------
;; 3D-ROTATIONSMATRIX
;; ------------------------------------------------------------
;; 4x4-Rotationsmatrix Rz(hz)*Ry(vert) fuer vla-TransformBy (vlax-tmatrix).
;; Argumente sind die BEREITS berechneten Winkelfunktionen:
;;   chz = cos(hz),  shz = sin(hz)   (horizontale Fahrtrichtung)
;;   cv  = cos(vert), sv = sin(vert) (vertikale Neigung, positiv = abwaerts)
;; Diese Matrix stand zuvor woertlich in insert-*-Funktionen von vf_core,
;; vf_etage, Gefaellestrecke und TEFInsert. Zentral hier, weil dependency-frei
;; und clusteruebergreifend genutzt. Werte unveraendert - reine Extraktion.
(defun ssg-rot-matrix-zy (chz shz cv sv)
  (list
    (list (* chz cv) (- shz) (* chz sv) 0)
    (list (* shz cv)   chz   (* shz sv) 0)
    (list (- sv)        0      cv       0)
    (list 0             0      0        1)
  )
)


;; ------------------------------------------------------------
;; 3x3-VEKTOR-/MATRIXHELFER (allgemein, dependency-frei)
;; ------------------------------------------------------------
;; Hier statt in vf_core.lsp, weil ssg-collect-nested-inserts-rel (weiter
;; unten in diesem Modul) sie ebenfalls braucht und dieses Modul IMMER vor
;; jedem Feature-Modul (inkl. vf_core.lsp) geladen ist - siehe MNL-Ladeliste.
;; vf_core.lsp (insert-block-ks-to-ks/insert-block-mixed-to-ks) nutzt
;; dieselben Definitionen unveraendert weiter.

;; Vektorkreuzprodukt a x b
(defun vec3-cross (a b)
  (list (- (* (cadr  a)(caddr b)) (* (caddr a)(cadr  b)))
        (- (* (caddr a)(car   b)) (* (car   a)(caddr b)))
        (- (* (car   a)(cadr  b)) (* (cadr  a)(car   b)))))

;; Vektor auf Einheitslaenge normieren
(defun vec3-normalize (v / len)
  (setq len (vec-length v))
  (if (> len 1e-10)
    (list (/ (car v) len) (/ (cadr v) len) (/ (caddr v) len))
    '(1.0 0.0 0.0)))

;; 3x3-Rotationsmatrix (Zeilenliste) mal 3D-Vektor
(defun mat3-mul-vec3 (R v / r0 r1 r2)
  (setq r0 (car R) r1 (cadr R) r2 (caddr R))
  (list (+ (* (car   r0)(car v)) (* (cadr  r0)(cadr v)) (* (caddr r0)(caddr v)))
        (+ (* (car   r1)(car v)) (* (cadr  r1)(cadr v)) (* (caddr r1)(caddr v)))
        (+ (* (car   r2)(car v)) (* (cadr  r2)(cadr v)) (* (caddr r2)(caddr v)))))

;; Rotationsmatrix R sodass: R*xe=xt, R*ye=yt, R*ze=zt
;; (xt yt zt) = Ziel-Achsen; (xe ye ze) = Quell-Achsen (je normierte Einheitsvektoren)
;; Formel: R = M_target * M_source^T
;;   R[i][j] = xt[i]*xe[j] + yt[i]*ye[j] + zt[i]*ze[j]
(defun mat3-from-frames (xt yt zt  xe ye ze)
  (list
    (list (+ (* (car   xt)(car   xe)) (* (car   yt)(car   ye)) (* (car   zt)(car   ze)))
          (+ (* (car   xt)(cadr  xe)) (* (car   yt)(cadr  ye)) (* (car   zt)(cadr  ze)))
          (+ (* (car   xt)(caddr xe)) (* (car   yt)(caddr ye)) (* (car   zt)(caddr ze))))
    (list (+ (* (cadr  xt)(car   xe)) (* (cadr  yt)(car   ye)) (* (cadr  zt)(car   ze)))
          (+ (* (cadr  xt)(cadr  xe)) (* (cadr  yt)(cadr  ye)) (* (cadr  zt)(cadr  ze)))
          (+ (* (cadr  xt)(caddr xe)) (* (cadr  yt)(caddr ye)) (* (cadr  zt)(caddr ze))))
    (list (+ (* (caddr xt)(car   xe)) (* (caddr yt)(car   ye)) (* (caddr zt)(car   ze)))
          (+ (* (caddr xt)(cadr  xe)) (* (caddr yt)(cadr  ye)) (* (caddr zt)(cadr  ze)))
          (+ (* (caddr xt)(caddr xe)) (* (caddr yt)(caddr ye)) (* (caddr zt)(caddr ze))))))

;; --- 3x3-Matrizenprodukt A*B (beide als Zeilenlisten wie mat3-from-frames) ---
;; Spalten von B einzeln mit A multiplizieren (mat3-mul-vec3), Ergebnis-Matrix
;; aus den 3 Ergebnis-Spalten wieder ueber mat3-from-frames zusammensetzen
;; (mit Einheitsvektoren als Quell-Achsen baut das eine Matrix AUS Spalten -
;; siehe mat3-from-normal-rotation, das denselben Trick nutzt).
(defun mat3-mul-mat3 (A B / b-col0 b-col1 b-col2)
  (setq b-col0 (list (caar B) (car   (cadr B)) (car   (caddr B))))
  (setq b-col1 (list (cadar B) (cadr  (cadr B)) (cadr  (caddr B))))
  (setq b-col2 (list (caddar B) (caddr (cadr B)) (caddr (caddr B))))
  (mat3-from-frames
    (mat3-mul-vec3 A b-col0) (mat3-mul-vec3 A b-col1) (mat3-mul-vec3 A b-col2)
    '(1.0 0.0 0.0) '(0.0 1.0 0.0) '(0.0 0.0 1.0))
)

;; --- OCS-Basis (Arbitrary Axis Algorithm) aus einer Extrusionsrichtung ---
;; normal = Extrusionsvektor (DXF-Gruppe 210/220/230, Laenge beliebig).
;; Rueckgabe: (ax ay az) - normierte OCS-Achsen, az = normiertes normal.
;; Standardalgorithmus (Autodesk "Arbitrary Axis Algorithm"): Referenzachse
;; ist Welt-Y, wenn normal nahe der Welt-Z-Achse liegt, sonst Welt-Z - damit
;; bleibt ax*ay*az immer ein wohldefiniertes, rechtshaendiges Dreibein, auch
;; wenn normal selbst (fast) mit der jeweiligen Referenzachse zusammenfaellt.
(defun mat3-ocs-basis (normal / n wy-ref ax ay)
  (setq n (vec3-normalize normal))
  (setq wy-ref
    (if (and (< (abs (car n)) (/ 1.0 64.0)) (< (abs (cadr n)) (/ 1.0 64.0)))
      '(0.0 1.0 0.0)
      '(0.0 0.0 1.0)))
  (setq ax (vec3-normalize (vec3-cross wy-ref n)))
  (setq ay (vec3-normalize (vec3-cross n ax)))
  (list ax ay n)
)

;; --- OCS-Basis als 3x3-Matrix (Spalten = ax ay az aus mat3-ocs-basis) ---
;; Rechnet einen OCS-lokalen Punkt/Vektor (z.B. die rohe INSERT-Gruppe 10
;; eines gekippten Elements) in echte lokale Koordinaten der Elternebene um:
;; (mat3-mul-vec3 (mat3-ocs-matrix normal) ocs-punkt).
(defun mat3-ocs-matrix (normal / basis)
  (setq basis (mat3-ocs-basis normal))
  (mat3-from-frames (car basis) (cadr basis) (caddr basis)
                     '(1.0 0.0 0.0) '(0.0 1.0 0.0) '(0.0 0.0 1.0))
)

;; --- Reine Z-Drehungsmatrix Rz(winkel), winkel in Radiant ---
(defun mat3-rz (winkel / c s)
  (setq c (cos winkel) s (sin winkel))
  (mat3-from-frames (list c s 0.0) (list (- s) c 0.0) '(0.0 0.0 1.0)
                     '(1.0 0.0 0.0) '(0.0 1.0 0.0) '(0.0 0.0 1.0))
)

;; --- Volle 3x3-Rotationsmatrix aus Extrusion + Drehwinkel (DXF-Gruppen 210/50) ---
;; normal = Extrusionsvektor, rotation = Drehwinkel in Radiant.
;; = OCS-Basis(normal) * Rz(rotation): erst die eigene Z-Drehung IN der
;; (evtl. gekippten) OCS-Ebene, dann diese Ebene selbst in die Elternebene
;; kippen. Fuer normal=(0 0 1) ist mat3-ocs-matrix die Einheitsmatrix, das
;; Ergebnis reduziert sich also exakt auf Rz(rotation) - fuer bereits flache
;; Elemente aendert sich damit nichts am bisherigen Verhalten.
(defun mat3-from-normal-rotation (normal rotation)
  (mat3-mul-mat3 (mat3-ocs-matrix normal) (mat3-rz rotation))
)


;; ------------------------------------------------------------
;; BENUTZER-ABFRAGEN
;; ------------------------------------------------------------

;; Ja/Nein-Abfrage mit konfigurierbarem Default
;; defa = T  -> Default ist "Yes" (Eingabe noetig um "No" zu waehlen)
;; defa = nil -> Default ist "No"
;; Rueckgabe: T wenn "No" gewaehlt (also Ablehnung), nil wenn "Yes"
(defun ssg-ques (prompt-text defa)
  (if defa
    (progn
      (initget 1 "Yes No  Yes")
      (= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-yes"))) "No")
    )
    (progn
      (initget 1 "Yes No  No")
      (= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-no"))) "Yes")
    )
  )
)

;; Fehlermeldung mit optionalem Signalton
;; ssg-bell = T -> kein Ton; nil -> Ton ausgeben
(defun ssg-emsg (text)
  (if (not ssg-bell) (prompt "\007"))
  (terpri)
  (prompt text)
  (terpri)
)


;; ------------------------------------------------------------
;; LAYER-HILFSFUNKTIONEN
;; ------------------------------------------------------------

;; Layer eines angeklickten Objektes ermitteln
;; txt = Prompt-Text fuer Objektauswahl
;; Rueckgabe: Layername als String, nil wenn Abbruch
(defun ssg-get-layer (txt / sel)
  (if (setq sel (entsel txt))
    (cdr (assoc 8 (entget (car sel))))
  )
)

;; Alle Objekte eines bestimmten Layers als Auswahlsatz liefern
;; lay-name = Layername; ent-typ = Entitaetstyp z.B. "LINE" (nil = alle)
(defun ssg-layer-ss (lay-name ent-typ)
  (if ent-typ
    (ssget "X" (list (cons 0 ent-typ) (cons 8 lay-name)))
    (ssget "X" (list (cons 8 lay-name)))
  )
)

;; Layer anlegen (falls nicht vorhanden) und optional aktivieren
;; lay-name = Name; color = Farbnummer als String z.B. "2"; set-aktiv = T/nil
;; Farbe wird nur bei Neuanlage gesetzt, bestehende Layer bleiben unveraendert
(defun ssg-make-layer (lay-name color set-aktiv / neu)
  (setq neu (not (tblsearch "LAYER" lay-name)))
  (if set-aktiv
    (command "_LAYER" "_M" lay-name "")
    (command "_LAYER" "_N" lay-name "")
  )
  (if neu
    (command "_LAYER" "_CO" color lay-name "")
  )
)

;; ------------------------------------------------------------
;; ZIEL-LAYER JE BAUGRUPPE (cfg/layer.cfg)
;; ------------------------------------------------------------
;; Fuer die Baugruppen, die die Makros aus Einzelteilen ZUSAMMENBAUEN
;; (KREISEL_n, ECKRAD_n, VF_n, GF_n) und fuer die selbst gezeichnete
;; Hilfsgeometrie (Tangenten, PIN-Linien, Beschriftungstexte) gibt es keine
;; Blockdatei in data/ und damit auch kein LAYER-Attribut - ihr Ziel-Layer
;; kommt aus cfg/layer.cfg. Bloecke, die nur EINGEFUEGT werden, nehmen
;; weiterhin ihr LAYER-Attribut (siehe ssg-block-layer-vorgabe unten).
;;
;; Bewusst hier in ssg_core.lsp und nicht in ssg_layer.lsp: jedes
;; Feature-Modul bootstrappt ssg_core selbst (KreiselInsert, Gefaellestrecke,
;; vf_core), ssg_layer aber nicht - dort waeren die Funktionen beim isolierten
;; Laden eines einzelnen Moduls nicht verfuegbar. ssg-make-layer und
;; ssg-insert-block liegen aus demselben Grund schon in dieser Datei.
;;
;; Alle Funktionen sind gutmuetig: fehlt die Datei, der Abschnitt, der Key oder
;; ist der Wert leer, liefern sie nil und der Aufrufer laesst den Layer
;; unangetastet - genau das Verhalten von vor der Umstellung.

(if (not (boundp '*ssg-layer-cfg*))      (setq *ssg-layer-cfg* nil))
(if (not (boundp '*ssg-layer-cfg-versucht*)) (setq *ssg-layer-cfg-versucht* nil))

;; cfg/layer.cfg einmalig laden (lazy, beim ersten Zugriff).
;; Ein fehlgeschlagener Ladeversuch wird gemerkt, damit nicht bei jeder
;; Einfuegung erneut auf die Platte zugegriffen wird.
;; Rueckgabe: ini-Alist oder nil.
(defun ssg-layer-cfg-load ( / cfg-dir pfad)
  (if (not *ssg-layer-cfg-versucht*)
    (progn
      (setq *ssg-layer-cfg-versucht* T)
      (setq cfg-dir (getenv "DXFM_CFG"))
      (if cfg-dir
        (progn
          (setq pfad (strcat (vl-string-right-trim "/\\"
                               (vl-string-translate "\\" "/" cfg-dir))
                             "/layer.cfg"))
          (setq *ssg-layer-cfg* (ssg-load-ini pfad))
        )
      )
    )
  )
  *ssg-layer-cfg*
)

;; Ladezustand zuruecksetzen (erzwingt Neu-Einlesen beim naechsten Zugriff).
;; Fuer Tests und fuer das Bearbeiten der cfg in laufender BricsCAD-Sitzung.
(defun ssg-layer-cfg-reset ( / )
  (setq *ssg-layer-cfg* nil
        *ssg-layer-cfg-versucht* nil)
  (princ)
)

;; Einen Eintrag "Layername, Farbe" aus den ini-Daten aufloesen.
;; Reine Funktion (ini-Daten als Parameter) - damit ohne Datei-IO testbar.
;; Rueckgabe: (layername . farbe-als-string) oder nil, wenn Key/Wert fehlt.
;; Der Layername endet am ERSTEN Komma (Layernamen enthalten kein Komma);
;; fehlt die Farbangabe, wird "7" verwendet.
(defun ssg-layer-cfg-eintrag (ini-data sektion schluessel / roh pos lay farbe)
  (setq roh (ssg-ini-get ini-data sektion schluessel nil))
  (if (and roh (= (type roh) 'STR))
    (progn
      (setq pos (vl-string-search "," roh))
      (if pos
        (setq lay   (vl-string-trim " \t" (substr roh 1 pos))
              farbe (vl-string-trim " \t" (substr roh (+ pos 2)))
        )
        (setq lay   (vl-string-trim " \t" roh)
              farbe ""
        )
      )
      (if (> (strlen lay) 0)
        (cons lay (if (> (strlen farbe) 0) farbe "7"))
      )
    )
  )
)

;; Ziel-Layer einer Baugruppe ermitteln.
;; schluessel = Baugruppen-Key aus cfg/layer.cfg, z.B. "variofoerderer"
;; Suchreihenfolge: [ils_<aktuelle Dimension>] -> [allgemein]
;; Rueckgabe: (layername . farbe) oder nil.
(defun ssg-layer-eintrag (schluessel / ini dim)
  (setq ini (ssg-layer-cfg-load))
  (if ini
    (progn
      (setq dim (strcase (ssg-ils-dim-aktuell) T))   ; "2d"/"3d"
      (cond
        ((ssg-layer-cfg-eintrag ini (strcat "ils_" dim) schluessel))
        ((ssg-layer-cfg-eintrag ini "allgemein" schluessel))
      )
    )
  )
)

;; Konfigurierte Farbe zu einem LAYERNAMEN (nicht zu einer Baugruppe) suchen.
;; Gebraucht fuer Layer, die aus dem LAYER-Attribut eines Blocks bzw. aus der
;; Blockdefinition kommen und daher keinen Baugruppen-Key haben: sie werden oft
;; VOR dem Wrapper angelegt, und ssg-make-layer setzt die Farbe nur bei der
;; Neuanlage - ohne diese Suche wuerde die Farbe aus cfg/layer.cfg nie greifen.
;; Suchreihenfolge:
;;   1. Abschnitt [farben]: Key = Layername, Wert = Farbe
;;   2. alle uebrigen Abschnitte: Eintrag, dessen LAYERNAME passt
;;      (Layernamen sind in AutoCAD/BricsCAD case-insensitiv)
;;   3. "7" als Grund-Default (bisheriges Verhalten)
;; Rueckgabe: Farbnummer als String, nie nil.
(defun ssg-layer-farbe-fuer-name (layname / ini treffer gesucht sek eintrag)
  (setq ini (ssg-layer-cfg-load))
  (if (or (null ini) (null layname) (= layname ""))
    "7"
    (progn
      (setq treffer (ssg-ini-get ini "farben" layname nil))
      (if (and treffer (> (strlen treffer) 0))
        (vl-string-trim " \t" treffer)
        (progn
          (setq gesucht (strcase layname))
          (foreach sek ini
            (if (and (null treffer) (/= (car sek) "farben"))
              (foreach eintrag (cdr sek)
                (if (null treffer)
                  (progn
                    ;; Wert des Eintrags wieder in (layer . farbe) zerlegen
                    (setq eintrag (ssg-layer-cfg-eintrag
                                    ini (car sek) (car eintrag)))
                    (if (and eintrag (= (strcase (car eintrag)) gesucht))
                      (setq treffer (cdr eintrag))
                    )
                  )
                )
              )
            )
          )
          (if treffer treffer "7")
        )
      )
    )
  )
)

;; Ziel-Layer einer Baugruppe anlegen (Farbe aus der cfg) und optional
;; aktivieren. aktiv = T setzt CLAYER auf den Layer.
;; Rueckgabe: Layername oder nil, wenn die Baugruppe nicht konfiguriert ist.
(defun ssg-layer-anlegen (schluessel aktiv / eintrag)
  (if (setq eintrag (ssg-layer-eintrag schluessel))
    (progn
      (ssg-make-layer (car eintrag) (cdr eintrag) aktiv)
      (car eintrag)
    )
  )
)

;; Objekt (in der Regel eine frisch eingefuegte Blockreferenz) auf den
;; Ziel-Layer seiner Baugruppe legen; der Layer wird bei Bedarf angelegt.
;; Rueckgabe: Layername oder nil, wenn die Baugruppe nicht konfiguriert ist
;; (dann bleibt das Objekt unveraendert auf seinem bisherigen Layer).
(defun ssg-layer-setzen (ent schluessel / lay ed)
  (if (and ent (setq lay (ssg-layer-anlegen schluessel nil)))
    (progn
      (setq ed (entget ent))
      (entmod (subst (cons 8 lay) (assoc 8 ed) ed))
      (entupd ent)
      lay
    )
  )
)

;; Layer einer nur EINGEFUEGTEN Blockreferenz aus der Block-Vorgabe setzen:
;; bevorzugt aus dem LAYER-Attribut des Blocks, sonst aus der "eigenen" Ebene
;; der Blockdefinition (ssg-ils-block-ebene). Traegt der Block beides nicht,
;; bleibt die Referenz auf ihrem bisherigen Layer.
;; ent      = Blockreferenz
;; realname = effektiver Blockname (fuer die Ebenen-Ermittlung)
;; attribs  = Attribut-Alist (ssg-attrib-read), nil = wird selbst gelesen
;; Rueckgabe: gesetzter Layername oder nil.
(defun ssg-block-layer-vorgabe (ent realname attribs / lay ed)
  (if (and ent (null attribs))
    (setq attribs (ssg-attrib-read ent))
  )
  (setq lay (cdr (assoc "LAYER" attribs)))
  (if (or (null lay) (= lay ""))
    (setq lay (ssg-ils-block-ebene realname))
  )
  (if (and ent lay (/= lay ""))
    (progn
      ;; Farbe aus cfg/layer.cfg, falls der Layername dort vorkommt (sonst "7").
      (ssg-make-layer lay (ssg-layer-farbe-fuer-name lay) nil)
      (setq ed (entget ent))
      (entmod (subst (cons 8 lay) (assoc 8 ed) ed))
      (entupd ent)
      lay
    )
  )
)

;; Auswahlsatz-Iteration: Funktion fuer jedes Element aufrufen
;; ss = Auswahlsatz; func = Funktion mit einem Parameter (entity-name)
(defun ssg-ss-foreach (ss func / i ename)
  (if ss
    (progn
      (setq i 0)
      (while (setq ename (ssname ss i))
        (func ename)
        (setq i (1+ i))
      )
    )
  )
)

;; Alle Elemente eines Auswahlsatzes hervorheben/zuruecksetzen
;; ss = Auswahlsatz; modus = 3 (hervorheben) / 4 (invertiert) / 0 (normal)
(defun ssg-ss-redraw (ss modus / i ename)
  (if ss
    (progn
      (setq i 0)
      (while (setq ename (ssname ss i))
        (redraw ename modus)
        (setq i (1+ i))
      )
    )
  )
)

;; Auswahlsatz zu einem anderen Auswahlsatz hinzufuegen (in-place)
;; src-ss = Quell-Auswahlsatz; dest-ss = Ziel-Auswahlsatz (wird modifiziert)
(defun ssg-ss-add (src-ss dest-ss / i ename)
  (if (null dest-ss) (setq dest-ss (ssadd)))
  (setq i 0)
  (while (setq ename (ssname src-ss i))
    (ssadd ename dest-ss)
    (redraw ename 3)
    (setq i (1+ i))
  )
  dest-ss
)


;; ------------------------------------------------------------
;; BLOCK-OPERATIONEN
;; ------------------------------------------------------------

;; Zeitstempel als YYYYMMDDHHMMSS erzeugen (fuer eindeutige Blocknamen)
(defun ssg-timestamp ( / cd ds ts)
  (setq cd (rtos (getvar "CDATE") 2 6))
  ;; cd = "20260518.143052" -> Punkt entfernen
  (setq ds (substr cd 1 8))
  (setq ts (substr cd 10 6))
  (strcat ds ts)
)

;; Eindeutigen Blocknamen aus Einfuegepunkt + Zeitstempel erzeugen
;; pt = Einfuegepunkt (Liste); Rueckgabe: Blockname als String
(defun ssg-make-blockname (pt / k1 k2)
  (setq k1 (strcat (itoa (abs (fix (car pt))))
                   (itoa (abs (fix (cadr pt))))
                   (itoa (abs (fix (caddr pt)))))
        k2 (substr (rtos (getvar "cdate") 2 9) 10 9)
  )
  (strcat k1 k2)
)

;; Einzel-Block einfuegen mit Layer anlegen
;; lay-name  = Ziel-Layer; color = Layerfarbe
;; blk-pfad  = vollstaendiger Blockpfad (ohne Erweiterung)
;; pt        = Einfuegepunkt; xscale yscale = Skalierung ("" = 1)
;; rotation  = Drehwinkel als String oder pause fuer interaktiv
(defun ssg-insert-block (lay-name color blk-pfad pt xscale yscale rotation)
  (ssg-make-layer lay-name color T)
  (command "_insert" blk-pfad pt xscale yscale rotation)
)

;; Block aus Auswahlsatz erstellen und gleich wieder einfuegen
;; pt         = Origin; rotation = Drehwinkel als String
;; ss         = Auswahlsatz der Elemente
;; Rueckgabe: Blockname (String)
(defun ssg-make-block (pt rotation ss / bname gefunden)
  (setq bname   (ssg-make-blockname pt)
        gefunden (tblsearch "block" bname)
  )
  (if (not gefunden)
    (progn
      (command "_block" bname pt ss "")
      (command "_insert" bname pt "" "" rotation)
    )
    (progn
      (alert (ssg-textf "core-blockname-exists" (list bname)))
      (setq bname (strcat "x" bname))
      (command "_block" bname pt ss "")
      (command "_insert" bname pt "" "" rotation)
    )
  )
  bname
)

;; ------------------------------------------------------------
;; ILS-BLOCKDATEI AUFLOESEN (2D/3D-Umschaltung)
;; ------------------------------------------------------------
;; Aktuell gueltige Dimension ("2D"/"3D") ermitteln, in dieser Reihenfolge:
;;   1) transienter Override *ssg-ils-dim* (fuer gezielten Neubau in EINER
;;      Dimension, z.B. Edit-Umschaltung oder Batch-Umwandlung),
;;   2) globaler Modus DXFM_DIM (Default fuer Neubauten),
;;   3) "3D" als Grund-Default.
(defun ssg-ils-dim-aktuell ( / )
  (cond
    ((and (boundp '*ssg-ils-dim*) (= (type *ssg-ils-dim*) 'STR)) *ssg-ils-dim*)
    ((= (type (getenv "DXFM_DIM")) 'STR) (getenv "DXFM_DIM"))
    (t "3D")))

;; Basisverzeichnis der ILS-Bloecke (…/data/ils/) oder nil.
(defun ssg-ils-basis ( / )
  (cond
    ((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
     (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
             "/data/ils/"))
    ((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
          (vl-string-search "/Lisp" *ssg-lisp-pfad*))
     (strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
             "/data/ils/"))
    (t nil)))

;; Effektiver Blockname zu einem ROH-Namen fuer eine EXPLIZITE Dimension.
;; Seit dem Flach-Refactor tragen Blocknamen das Dimensionssuffix _2D/_3D, damit
;; 2D- und 3D-Variante gleichzeitig in einer Zeichnung existieren koennen
;; (Datei = Blockname + ".dwg", flach unter data/ils/). Ausnahmen ohne Suffix:
;;   - Koordinaten-/Subbloecke KS_EIN/KS_AUS/KSYS_*/K1..K4 (exakte Export-Matches),
;;   - bereits mit _2D/_3D versehene Namen (kein doppeltes Anhaengen).
(defun ssg-ils-blockname-dim (roh dim / )
  (cond
    ((wcmatch (strcase roh) "KS_EIN,KS_AUS,KSYS_EIN,KSYS_AUS,K1,K2,K3,K4") roh)
    ((wcmatch (strcase roh) "*_2D,*_3D") roh)
    (t (strcat roh "_" dim))))

;; Effektiver Blockname fuer die AKTUELLE Dimension (siehe ssg-ils-dim-aktuell).
(defun ssg-ils-blockname (roh / )
  (ssg-ils-blockname-dim roh (ssg-ils-dim-aktuell)))

;; Liefert den vollstaendigen .dwg-Pfad (flache Ablage data/ils/<blockname>.dwg)
;; zu einem ROH-Blocknamen fuer eine EXPLIZITE Dimension. Faellt automatisch auf
;; die 3D-Variante zurueck, wenn die Datei der gewuenschten Dimension (noch) nicht
;; existiert - so nutzen z.B. Vario_Motorstation/-Umlenkstation im 2D-Modus
;; vorlaeufig die 3D-Datei.
;; Rueckgabe: Pfad-String oder nil (Block weder in Dim noch in 3D gefunden).
(defun ssg-ils-block-datei-dim (blockname dim / basis datei datei3d)
  (setq basis (ssg-ils-basis))
  (if (null basis)
    nil
    (progn
      (setq datei   (strcat basis (ssg-ils-blockname-dim blockname dim)  ".dwg"))
      (setq datei3d (strcat basis (ssg-ils-blockname-dim blockname "3D") ".dwg"))
      (cond
        ((findfile datei)   datei)      ; gewuenschte Dimension
        ((findfile datei3d) datei3d)    ; Fallback: 3D-Variante
        (t nil))
    )
  )
)

;; Wie ssg-ils-block-datei-dim, aber fuer die AKTUELLE Dimension.
(defun ssg-ils-block-datei (blockname / )
  (ssg-ils-block-datei-dim blockname (ssg-ils-dim-aktuell)))

;; ------------------------------------------------------------
;; REDEFINE-SPERRE (eine DWG-Lesung pro Block und Zeichnung)
;; ------------------------------------------------------------
;; Merkliste der in DIESER Zeichnung schon einmal aus der DWG-Datei neu
;; definierten (redefinierten) Blocknamen. Grundlage der Sperre in
;; ssg-ils-block-laden-dim. Namen werden in Grossschreibung gehalten, weil
;; Blocknamen in CAD case-insensitiv sind. LISP-Variablen sind pro Dokument
;; eigenstaendig, die Liste gilt also automatisch je Zeichnung.
(if (not (boundp '*ssg-block-refreshed*)) (setq *ssg-block-refreshed* nil))

(defun ssg-block-refreshed-p (eff / )
  (and (boundp '*ssg-block-refreshed*)
       (member (strcase eff) *ssg-block-refreshed*)
       t))

(defun ssg-block-refreshed-set (eff / )
  (if (not (ssg-block-refreshed-p eff))
    (setq *ssg-block-refreshed* (cons (strcase eff) *ssg-block-refreshed*)))
  eff)

;; Sperre aufheben - erzwingt beim naechsten ssg-ils-block-laden(-dim) ein
;; erneutes Einlesen der DWG. Argument nil: ALLE Bloecke; ROH- oder effektiver
;; Blockname: nur dieser (beide Dimensionen). Noetig, wenn eine Block-DWG
;; waehrend der laufenden Sitzung geaendert wurde.
(defun ssg-block-refresh-reset (blockname / rest n2 n3 nroh)
  (if (null blockname)
    (setq *ssg-block-refreshed* nil)
    (progn
      (setq nroh (strcase blockname)
            n2   (strcase (ssg-ils-blockname-dim blockname "2D"))
            n3   (strcase (ssg-ils-blockname-dim blockname "3D"))
            rest '())
      (foreach n *ssg-block-refreshed*
        (if (not (or (= n nroh) (= n n2) (= n n3)))
          (setq rest (cons n rest))))
      (setq *ssg-block-refreshed* rest)))
  (princ))

;; Stellt sicher, dass die Block-DEFINITION zum ROH-Namen 'blockname' in einer
;; EXPLIZITEN Dimension geladen ist. Blocknamen tragen das Suffix _2D/_3D
;; (siehe ssg-ils-blockname-dim), daher koennen 2D und 3D gleichzeitig existieren.
;; Ein bereits vorhandener gleichnamiger Block wird EINMAL PRO ZEICHNUNG neu aus
;; der Datei definiert (Redefine), damit eine veraltete Definition aus einer
;; frueheren Sitzung (z.B. mit falschem 2D/3D-Inhalt) nicht wiederverwendet wird.
;; Jeder WEITERE Aufruf fuer denselben effektiven Blocknamen ueberspringt das
;; Neu-Definieren (siehe *ssg-block-refreshed*): Ohne diese Sperre las jede
;; einzelne Element-Einfuegung die DWG erneut von der Platte - bei den grossen
;; 3D-Bloecken (AS_Element_90_links_3D ~52 MB, ES_Element_90_links_3D ~9 MB)
;; und zusaetzlich einer Regeneration aller bereits platzierten Referenzen
;; dieses Blocks. Bei Tests mit vielen Strecken (TEST_MUBEA, Gefaellestrecke-
;; und Foerderer-Tests) fuehrte das zu minutenlangen Laufzeiten.
;; Zum erzwungenen Neu-Einlesen: ssg-block-refresh-reset.
;; Rueckgabe: effektiver (suffigierter) Blockname oder nil (Datei nicht gefunden).
(defun ssg-ils-block-laden-dim (blockname dim / eff datei base temp-obj osm areq adia)
  (setq eff   (ssg-ils-blockname-dim blockname dim))
  (setq datei (ssg-ils-block-datei-dim blockname dim))
  (if (null datei)
    nil
    (progn
      (setq base (vl-filename-base datei))
      ;; Sichtbar machen, wenn die Datei der gewuenschten Dimension fehlt und der
      ;; 3D-Fallback greift (dann traegt der Block den gewuenschten Namen, aber
      ;; den Inhalt der anderen Dimension = potenziell falsche Referenz). Jeder
      ;; aktiv eingefuegte Block sollte in BEIDEN Dimensionen vorliegen.
      (if (not (= (strcase base) (strcase eff)))
        (princ (strcat "\n[SSG] WARNUNG: Blockdatei '" eff
                       ".dwg' fehlt - Fallback auf '" base
                       ".dwg' (Inhalt evtl. andere Dimension).")))
      ;; In dieser Zeichnung bereits aus der Datei aktualisiert UND noch in der
      ;; Blocktabelle vorhanden -> nichts zu tun, die Definition ist aktuell.
      ;; Die tblsearch-Pruefung faengt ab, dass der Block zwischenzeitlich
      ;; entfernt wurde (z.B. per PURGE) und neu geladen werden muss.
      (if (and (ssg-block-refreshed-p eff) (tblsearch "BLOCK" eff))
        eff
        (progn
          (if (and (not (tblsearch "BLOCK" eff)) (= (strcase base) (strcase eff)))
            ;; Neu UND Dateiname == Blockname -> COM-Weg (kein Prompt).
            (progn
              (setq temp-obj (vla-InsertBlock modelspace
                               (vlax-3D-point '(0 0 0)) datei 1.0 1.0 1.0 0))
              (vla-Delete temp-obj))
            ;; Sonst (Block existiert bereits ODER Dateiname != Blockname wg.
            ;; 3D-Fallback) -> aus Datei (neu) definieren. "_Y" beantwortet die
            ;; Redefine-Abfrage, falls der Block bereits vorhanden ist; danach die
            ;; laufende Einfuegung sofort abbrechen (Definition ist bereits wirksam).
            (progn
              (setq areq (getvar "ATTREQ") adia (getvar "ATTDIA") osm (getvar "OSMODE"))
              (setvar "ATTREQ" 0)(setvar "ATTDIA" 0)(setvar "OSMODE" 0)
              (if (tblsearch "BLOCK" eff)
                (command "_.-INSERT" (strcat eff "=" datei) "_Y")   ; Redefine bestehender Block
                (command "_.-INSERT" (strcat eff "=" datei)))       ; neu (kein Redefine-Prompt)
              (if (> (getvar "CMDACTIVE") 0) (command))
              (if (> (getvar "CMDACTIVE") 0) (command))
              (setvar "OSMODE" osm)(setvar "ATTREQ" areq)(setvar "ATTDIA" adia)))
          ;; Nur merken, wenn die Definition danach wirklich vorhanden ist -
          ;; sonst wuerde ein fehlgeschlagener Ladeversuch dauerhaft gesperrt.
          (if (tblsearch "BLOCK" eff) (ssg-block-refreshed-set eff))
          eff)))))

;; Wie ssg-ils-block-laden-dim, aber fuer die AKTUELLE Dimension.
(defun ssg-ils-block-laden (blockname / )
  (ssg-ils-block-laden-dim blockname (ssg-ils-dim-aktuell)))

;; ------------------------------------------------------------
;; AUTO-LAYER: INSERT-Referenz auf die eigene Ebene ihres Blocks setzen
;; ------------------------------------------------------------
;; Ermittelt die "eigene" Ebene eines geladenen Blocks (haeufigste Ebene ausser
;; "0" seiner Definition-Entities); nil, wenn nur "0".
(defun ssg-ils-block-ebene (realname / blocks blk e lay pair counts best best-n c)
  (if (and realname (tblsearch "BLOCK" realname))
    (progn
      (setq blocks (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
      (setq blk (vla-item blocks realname))
      (setq counts '())
      (vlax-for e blk
        (setq lay (vla-get-Layer e))
        (if (and lay (/= lay "0"))
          (progn
            (setq pair (assoc lay counts))
            (if pair
              (setq counts (subst (cons lay (1+ (cdr pair))) pair counts))
              (setq counts (cons (cons lay 1) counts))))))
      (setq best nil best-n 0)
      (foreach c counts (if (> (cdr c) best-n) (setq best (car c) best-n (cdr c))))
      best)
    nil))

;; Setzt die INSERT-Referenz (VLA-Objekt) auf die eigene Ebene ihres Blocks
;; (legt die Ebene an, falls noetig). No-op, wenn keine eigene Ebene ermittelbar.
(defun ssg-ils-block-auf-ebene (obj realname / eb)
  (setq eb (ssg-ils-block-ebene realname))
  (if (and eb obj)
    (progn
      ;; Farbe aus cfg/layer.cfg, falls der Layername dort vorkommt (sonst "7").
      (if (not (tblsearch "LAYER" eb))
        (ssg-make-layer eb (ssg-layer-farbe-fuer-name eb) nil))
      (vl-catch-all-apply (function (lambda () (vla-put-Layer obj eb))))))
  obj)

;; ------------------------------------------------------------
;; DIMENSIONS-XDATA (2D/3D) je Block - App "SSG_DIM"
;; ------------------------------------------------------------
;; Merkt sich, in welcher Dimension ein GF_/VF_-Block gebaut wurde, damit der
;; Doppelklick-Edit die aktuelle Dimension automatisch erkennen kann. Bewusst
;; getrennt vom fachlichen XDATA/Attributsatz (Export bleibt unveraendert).
(if (null *ssg-dim-xdata-app*) (setq *ssg-dim-xdata-app* "SSG_DIM"))

(defun ssg-dim-xdata-schreiben (ent dim / )
  (if (and ent dim)
    (progn
      (regapp *ssg-dim-xdata-app*)
      (entmod
        (append (entget ent)
          (list (list -3 (list *ssg-dim-xdata-app* (cons 1000 dim))))))))
  ent)

;; Rueckgabe: "2D"/"3D" oder nil (kein Eintrag -> Aufrufer nimmt Default 3D).
(defun ssg-dim-xdata-lesen (ent / xd app-data)
  (setq xd (entget ent (list *ssg-dim-xdata-app*)))
  (setq app-data (cdr (assoc -3 xd)))
  (if app-data
    (car (mapcar 'cdr (cdr (car app-data))))
    nil))


;; ------------------------------------------------------------
;; ATTRIBUT-OPERATIONEN
;; ------------------------------------------------------------

;; Attribut eines Blocks (letzte Einfuegung) aendern
;; tag     = Attributbezeichner (z.B. "ARTINR")
;; wert    = neuer Wert
;; ersetzen = T -> vollstaendiger Ersatz; nil -> Anfuegen
(defun ssg-attrib-set (tag wert ersetzen / obj typ attr-tag attr-wert)
  (setq obj (entlast))
  (while (not (equal (cdr (assoc 0 (entget obj))) "SEQEND"))
    (setq typ (cdr (assoc 0 (entget obj))))
    (if (equal typ "ATTRIB")
      (progn
        (setq attr-tag  (cdr (assoc 2 (entget obj)))
              attr-wert (cdr (assoc 1 (entget obj)))
        )
        (if (equal attr-tag tag)
          (if ersetzen
            (entmod (subst (cons 1 wert)
                           (assoc 1 (entget obj)) (entget obj)))
            (entmod (subst (cons 1 (strcat attr-wert wert))
                           (assoc 1 (entget obj)) (entget obj)))
          )
        )
      )
    )
    (setq obj (entnext obj))
  )
)

;; Mehrere Attribute eines Blocks auf einmal setzen
;; attrib-alist = Assoziationsliste '(("TAG1" . "Wert1") ("TAG2" . "Wert2") ...)
(defun ssg-attrib-set-many (attrib-alist / obj typ tag wert)
  (setq obj (entlast))
  (while (not (equal (cdr (assoc 0 (entget obj))) "SEQEND"))
    (setq typ (cdr (assoc 0 (entget obj))))
    (if (equal typ "ATTRIB")
      (progn
        (setq tag (cdr (assoc 2 (entget obj))))
        (setq wert (cdr (assoc tag attrib-alist)))
        (if (and wert (> (strlen wert) 0))
          (entmod (subst (cons 1 wert)
                         (assoc 1 (entget obj)) (entget obj)))
        )
      )
    )
    (setq obj (entnext obj))
  )
)

;; Alle Attribute eines INSERT-Entity als Assoziationsliste lesen.
;; ent = Entity-Name eines INSERT mit Attributen.
;; Rueckgabe: (("TAG1" . "Wert1") ("TAG2" . "Wert2") ...) oder nil
(defun ssg-attrib-read (ent / e ed result)
  (setq e (entnext ent))
  (while e
    (setq ed (entget e))
    (if (equal (cdr (assoc 0 ed)) "SEQEND")
      (setq e nil)
      (progn
        (if (equal (cdr (assoc 0 ed)) "ATTRIB")
          (setq result (cons (cons (cdr (assoc 2 ed)) (cdr (assoc 1 ed))) result))
        )
        (setq e (entnext e))
      )
    )
  )
  (reverse result)
)

;; Default-Attribute aus einer Definitionsliste erzeugen.
;; attrib-defs = Liste von (TAG DEFAULT) Paaren, z.B. '(("TYP" "A") ("NR" "0"))
;; Rueckgabe: Assoziationsliste (("TYP" . "A") ("NR" . "0") ...)
(defun ssg-attrib-defaults (attrib-defs / result)
  (foreach def attrib-defs
    (setq result (cons (cons (car def) (cadr def)) result))
  )
  (reverse result)
)

;; Gegebene Attribute mit Defaults zusammenfuehren.
;; given       = alist mit Ueberschreibungen (darf nil sein)
;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...)
;; Rueckgabe: vollstaendige alist mit allen Tags
(defun ssg-attrib-merge (given attrib-defs / defaults pair existing)
  (setq defaults (ssg-attrib-defaults attrib-defs))
  (if given
    (foreach pair given
      (setq existing (assoc (car pair) defaults))
      (if existing
        (setq defaults (subst pair existing defaults))
        (setq defaults (append defaults (list pair)))
      )
    )
  )
  defaults
)

;; Unsichtbare ATTDEF-Entities bei (0,0) erzeugen.
;; Muss VOR dem _BLOCK-Befehl aufgerufen werden, damit die ATTDEFs
;; Teil der Blockdefinition werden.
;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...)
;; text-height = Texthoehe der ATTDEFs (z.B. 50.0)
(defun ssg-attrib-make-defs (attrib-defs text-height / ypos)
  (setq ypos 0.0)
  (foreach def attrib-defs
    (entmake (list
      '(0 . "ATTDEF")
      '(8 . "0")
      (cons 10 (list 0.0 ypos 0.0))
      (cons 40 text-height)
      (cons 1 (cadr def))
      (cons 3 (car def))
      (cons 2 (car def))
      '(70 . 1)
    ))
    (setq ypos (- ypos (* text-height (ssg-cfg-or "infrastruktur" "attdef_y_spacing_factor" 2.0))))
  )
)

;; Attribute eines bestimmten INSERT-Entity setzen (nicht entlast).
;; ent          = Entity-Name des INSERT-Blocks
;; attrib-alist = (("TAG" . "Wert") ...)
(defun ssg-attrib-set-on (ent attrib-alist / obj ed typ tag wert)
  (setq obj (entnext ent))
  (while obj
    (setq ed (entget obj))
    (setq typ (cdr (assoc 0 ed)))
    (if (equal typ "SEQEND") (setq obj nil)
      (progn
        (if (equal typ "ATTRIB")
          (progn
            (setq tag (cdr (assoc 2 ed)))
            (setq wert (cdr (assoc tag attrib-alist)))
            (if (and wert (= (type wert) 'STR) (> (strlen wert) 0))
              (progn
                (entmod (subst (cons 1 wert) (assoc 1 ed) ed))
                (entupd obj)
              )
            )
          )
        )
        (setq obj (entnext obj))
      )
    )
  )
)

;; --- Sub-INSERTs einer Blockdefinition nach Namensmuster sammeln ---
;; bname   = Name einer Blockdefinition (z.B. eines VF_n/GF_n-Compound-Blocks)
;; pattern = wcmatch-Muster, z.B. "Separator_SP*,S-LP*"
;; Beim finalen Zusammenbau von VF_n/GF_n/KREISEL_n (ssg-block-wrap-welt bzw.
;; das abschliessende "_.-BLOCK") werden alle bis dahin einzeln eingefuegten
;; Bauteile - inkl. Sensoren wie Separator_SP, die vorher eigene, top-level
;; INSERTs waren - zu Sub-INSERTs IN DER Compound-Blockdefinition. Sie
;; verlieren dadurch ihre Sichtbarkeit fuer (ssget "X" ...): das findet nur
;; Entities im Modell-/Papierraum, keine Entities innerhalb einer
;; Blockdefinition. csv:sep-proxies-erzeugen (export.lsp) nutzt diese
;; Funktion, um genau die verpackten Separator_SP-Symbole vor dem Export
;; aufzuspueren und je eine echte, temporaere Kopie daneben einzufuegen -
;; die durchlaeuft ID-Vergabe/Export danach ganz normal ueber die
;; unveraenderten ssg-id-check-all/csv:collect-export-blocks. Rekursiv,
;; falls ein Treffer selbst nochmal in einem weiteren Sub-Compound-Block
;; steckt.
;;
;; Rueckgabe: Liste von Treffer-Records, oder nil. Ein Record ist
;;   (ename (x y z) R sx sy sz)
;; mit der Platzierung des Treffers RELATIV zur abgefragten Blockdefinition
;; bname - ueber alle Verschachtelungsebenen hinweg aufsummiert (Position,
;; volle 3D-Rotationsmatrix R und Skalierung). Der Aufrufer muss also nur
;; noch die Platzierung des top-level INSERT daraufrechnen. Der rohe
;; Einfuegepunkt aus (entget ename) ist bei mehr als einer Ebene NICHT
;; verwendbar - er gilt nur innerhalb der unmittelbaren Zwischen-
;; Blockdefinition.
;;
;; Kein Selection-Set: die Entities sind nicht Space-resident und damit fuer
;; ssadd nicht sicher verwendbar. Sie bleiben ueber entget normal lesbar
;; (Blockname, Attribute), sollten aber NICHT direkt exportiert werden - eine
;; eigene Bounding-Box (vla-getboundingbox) liefert fuer sie keine sinnvollen
;; Weltkoordinaten.
(defun ssg-collect-nested-inserts (bname pattern)
  (ssg-collect-nested-inserts-rel bname pattern '(0.0 0.0 0.0)
    '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
    1.0 1.0 1.0)
)

;; --- Rekursions-Rumpf mit mitgefuehrter Platzierung ---
;; basis-pt/basis-R/bsx/bsy/bsz = Platzierung der gerade durchsuchten
;; Blockdefinition im Koordinatensystem des URSPRUENGLICH abgefragten Blocks.
;; Auf jeder Ebene wird der Einfuegepunkt des Sub-INSERT erst mit der
;; Skalierung, dann mit der Rotation der Ebene darueber verrechnet und
;; aufaddiert - genau das fehlte frueher: die Rekursion gab die Entities
;; tieferer Ebenen mit ihrer ROH-Position aus der jeweiligen Zwischen-
;; Blockdefinition zurueck. Zwei Separatoren, die in zwei verschieden
;; platzierten Zwischenbloecken an derselben lokalen Stelle sitzen, landeten
;; dadurch auf exakt derselben Weltposition (und damit beim falschen Carrier).
;;
;; basis-R ist eine VOLLE 3x3-Rotationsmatrix (mat3-* oben in diesem Modul),
;; keine reine Z-Drehung mehr: ein Sub-INSERT, dessen Extrusionsrichtung
;; (DXF-Gruppe 210) von der Welt-Z-Achse abweicht - z.B. die um den
;; Gefaellewinkel gekippte Staustrecke/Separator-Kette in
;; Gefaellestrecke.lsp/vf_standard.lsp (ssg-rot-matrix-zy, Rz(hz)*Ry(-vert))
;; - hat seinen eigenen Einfuegepunkt (Gruppe 10) NICHT in den gewoehnlichen
;; lokalen XYZ-Koordinaten der Elterndefinition, sondern relativ zu SEINER
;; EIGENEN, gekippten OCS-Ebene (Arbitrary Axis Algorithm). Die fruehere
;; reine Z-Drehung ignorierte das komplett und lieferte fuer gekippte Ketten
;; einen falschen, von der tatsaechlichen Fahrtrichtung unabhaengigen
;; ("eingefrorenen") Weltpunkt. mat3-ocs-matrix wandelt die rohe OCS-lokale
;; Gruppe-10 in echte lokale Koordinaten um, bevor sie mit der Eltern-
;; Rotation weiterverrechnet wird; mat3-from-normal-rotation liefert die
;; volle 3D-Orientierung des Sub-INSERTs selbst (fuer die naechste
;; Rekursionsebene bzw. den Treffer-Record). Fuer Extrusion=(0 0 1) (der
;; Normalfall, z.B. Kreisel/Eckrad) reduziert sich beides exakt auf die alte
;; reine Z-Drehung - unveraendertes Verhalten dort.
(defun ssg-collect-nested-inserts-rel (bname pattern basis-pt basis-R bsx bsy bsz
                                       / blk-tbl sub-ent sub-ed sub-bname loc-pt
                                         extrusion rot sx sy sz ocs-mat loc-pt-real
                                         scaled-pt rot-pt R-local R-world world-pt
                                         result)
  (setq blk-tbl (tblsearch "BLOCK" bname))
  (if blk-tbl
    (progn
      (setq sub-ent (entnext (cdr (assoc -2 blk-tbl))))
      (while sub-ent
        (setq sub-ed (entget sub-ent))
        (if (= (cdr (assoc 0 sub-ed)) "INSERT")
          (progn
            (setq sub-bname (cdr (assoc 2 sub-ed)))
            (setq loc-pt (cdr (assoc 10 sub-ed)))
            (if (null (caddr loc-pt))
              (setq loc-pt (list (car loc-pt) (cadr loc-pt) 0.0)))
            (setq rot (cond ((cdr (assoc 50 sub-ed))) (0.0)))
            (setq extrusion (cond ((cdr (assoc 210 sub-ed))) ('(0.0 0.0 1.0))))
            (setq sx  (cond ((cdr (assoc 41 sub-ed))) (1.0)))
            (setq sy  (cond ((cdr (assoc 42 sub-ed))) (1.0)))
            (setq sz  (cond ((cdr (assoc 43 sub-ed))) (1.0)))
            ;; Gruppe-10 ist OCS-lokal (relativ zu diesem Sub-INSERTs EIGENER
            ;; Extrusion) - erst in echte lokale Koordinaten der aktuell
            ;; durchsuchten Blockdefinition umrechnen, dann skalieren, dann
            ;; mit der Eltern-Matrix in Weltkoordinaten drehen/verschieben.
            (setq ocs-mat (mat3-ocs-matrix extrusion))
            (setq loc-pt-real (mat3-mul-vec3 ocs-mat loc-pt))
            (setq scaled-pt (list (* bsx (car loc-pt-real))
                                  (* bsy (cadr loc-pt-real))
                                  (* bsz (caddr loc-pt-real))))
            (setq rot-pt (mat3-mul-vec3 basis-R scaled-pt))
            (setq world-pt (list (+ (car   basis-pt) (car   rot-pt))
                                 (+ (cadr  basis-pt) (cadr  rot-pt))
                                 (+ (caddr basis-pt) (caddr rot-pt))))
            ;; Volle 3D-Orientierung dieses Sub-INSERTs in Weltkoordinaten.
            (setq R-local (mat3-from-normal-rotation extrusion rot))
            (setq R-world (mat3-mul-mat3 basis-R R-local))
            (if (wcmatch sub-bname pattern)
              (setq result (cons (list sub-ent world-pt R-world
                                       (* bsx sx) (* bsy sy) (* bsz sz))
                                 result))
              (setq result (append result
                (ssg-collect-nested-inserts-rel sub-bname pattern
                  world-pt R-world
                  (* bsx sx) (* bsy sy) (* bsz sz))))
            )
          )
        )
        (setq sub-ent (entnext sub-ent))
      )
    )
  )
  result
)

;; ============================================================
;; GEMEINSAMES ATTRIBUT-SCHEMA FUER STRECKEN-BLOECKE
;; (Gefaellestrecke + VarioFoerderer, feste Reihenfolge)
;; ============================================================
;; Vorderteil (immer vorhanden). Bezeichnung = Blockname (GF_n/VF_n),
;; ARTINR fest 6220 (alle GF/VF). TYP-Wert wird zur Laufzeit gesetzt.
;; ID zuerst (global, jeder eingefuegte Baustein - Kreisel/GF/VF - erhaelt eine
;; neue ID), danach Bezeichnung (= Blockname). Hoehen/Delta mit Einheit _mm.
;; WINKEL_AS/WINKEL_ES: Elementwinkel (30/60/90, als String) des AS-/ES-
;; Elements, sofern eines gewaehlt wurde - sonst leer (kein AS/ES vorhanden).
(setq *strecke-attr-front*
  '(("ID"                   "")
    ("Bezeichnung"          "")
    ("ARTINR"               "6220")
    ("MONTAGEHOEHE_m"       "0.000")
    ("HOEHE_VON_mm"         "0")
    ("HOEHE_BIS_mm"         "0")
    ("DELTA_H_mm"           "0")
    ("DELTA_L_mm"           "0")
    ("TYP"                  "Streckengruppe")
    ("SEITE_AS"             "rechts")
    ("WINKEL_AS"            "")
    ("SEITE_ES"             "rechts")
    ("WINKEL_ES"            "")
    ("ANZAHL_GF"            "0")
    ("L_GF_m"               "0.000")
    ("GF_WINKEL"            "0.0")))

;; Mittelteil - nur fuer TYP "Streckengruppe" (mehrsegmentig/mit Bogen bzw. VF).
;; Eine einsegmentige Gefaellestrecke ohne Bogen ("Gefaellestrecke") bekommt
;; diese Attribute NICHT.
(setq *strecke-attr-gruppe*
  '(("GF_Bogen_L_90"        "0")
    ("GF_Bogen_L_60"        "0")
    ("GF_Bogen_L_30"        "0")
    ("GF_Bogen_R_90"        "0")
    ("GF_Bogen_R_60"        "0")
    ("GF_Bogen_R_30"        "0")
    ("ANZAHL_VF"            "0")
    ("MOTORSEITE"           "")
    ("L_VF_m"               "0.000")
    ("ANTRIEBFAHRTRICHTUNG" "Auf")
    ("VF_WINKEL"            "0")
    ("VF_Bogen_A_90"        "0")
    ("VF_Bogen_A_60"        "0")
    ("VF_Bogen_A_30"        "0")
    ("VF_Bogen_I_90"        "0")
    ("VF_Bogen_I_60"        "0")
    ("VF_Bogen_I_30"        "0")))

;; Hinterteil (immer vorhanden). ANZAHL_SEPARATOR-Wert wird zur Laufzeit gesetzt
;; (einsegmentige Gefaellestrecke: 1; Streckengruppe: gezaehlt).
(setq *strecke-attr-hinten*
  '(("ANZAHL_SEPARATOR"     "1")
    ("ANZAHL_SCANNER"       "0")
    ("GERUEST_EINZELMODUL"  "1")
    ("GERUEST_TYP"          "Schoenenberger Geruest")))

;; ============================================================
;; GERUESTOPTION - gemeinsame Combobox-Werte fuer Kreisel, Eckrad,
;; VarioFoerderer und Gefaellestrecke (Attribut GERUEST_TYP).
;; Reihenfolge = Reihenfolge in der Dialog-Combobox. Index 2
;; ("Schoenenberger Geruest") ist der Default.
;; ============================================================
(setq *ssg-geruest-optionen*
  '("IPE-Geruest abgestuft"
    "Obergeruest oben"
    "Schoenenberger Geruest"
    "nur Doppelrohrtraeger")
)

;; Geruest-Typ (String) -> Combobox-Index. Unbekannter/leerer Wert -> Default (2).
(defun ssg-geruest-typ-to-idx (typ / idx i gefunden)
  (setq idx 2 i 0 gefunden nil)
  (foreach opt *ssg-geruest-optionen*
    (if (and (not gefunden) (equal typ opt))
      (progn (setq idx i) (setq gefunden T))
    )
    (setq i (1+ i))
  )
  idx
)

;; Combobox-Index -> Geruest-Typ (String).
(defun ssg-geruest-idx-to-typ (idx)
  (nth idx *ssg-geruest-optionen*)
)

;; Geruestoption per Kommandozeilen-Menue abfragen (fuer Module ohne DCL-Dialog,
;; z.B. ILS_Eckrad). Rueckgabe: Geruest-Typ-String aus *ssg-geruest-optionen*.
(defun ssg-ask-geruest-typ ( / i opt antwort idx)
  (princ (ssg-text "geruest-typ-header"))
  (setq i 1)
  (foreach opt *ssg-geruest-optionen*
    (princ (ssg-textf "geruest-typ-opt" (list i opt)))
    (setq i (1+ i))
  )
  (setq antwort (getint (ssg-textf "geruest-typ-prompt" (list (itoa (1+ (ssg-geruest-typ-to-idx nil)))))))
  (if (or (null antwort) (< antwort 1) (> antwort (length *ssg-geruest-optionen*)))
    (setq idx (ssg-geruest-typ-to-idx nil))
    (setq idx (1- antwort))
  )
  (ssg-geruest-idx-to-typ idx)
)

;; Geordnete ATTDEF-Definitionsliste fuer einen Strecken-Block-Typ.
;;   typ "Gefaellestrecke" -> Vorderteil + Hinterteil (reduziert)
;;   sonst ("Streckengruppe") -> Vorderteil + Mittelteil + Hinterteil (voll)
(defun ssg-strecke-attrib-defs (typ)
  (if (= typ "Gefaellestrecke")
    (append *strecke-attr-front* *strecke-attr-hinten*)
    (append *strecke-attr-front* *strecke-attr-gruppe* *strecke-attr-hinten*)))

;; Assoziationsliste in ATTDEF-Definitionsliste konvertieren.
;; alist = (("TAG" . "Wert") ...) -> ((TAG Wert) ...)
;; Passend fuer ssg-attrib-make-defs.
(defun ssg-attrib-alist-to-defs (alist / result)
  (foreach pair alist
    (setq result (cons (list (car pair) (cdr pair)) result))
  )
  (reverse result)
)

;; Block (.dwg) temporaer einfuegen, Attribute lesen, Block loeschen.
;; dwg-pfad = vollstaendiger Pfad zur .dwg Datei
;; Rueckgabe: Assoziationsliste (("TAG" . "Wert") ...) oder nil
(defun ssg-attrib-read-dwg (dwg-pfad / tmpEnt srcAttribs oldAttreq oldAttdia)
  (if (not (findfile dwg-pfad))
    (progn
      (princ (ssg-textf "core-dwg-not-found" (list dwg-pfad)))
      nil
    )
    (progn
      (setq oldAttreq (getvar "ATTREQ"))
      (setq oldAttdia (getvar "ATTDIA"))
      (setvar "ATTREQ" 0)
      (setvar "ATTDIA" 0)
      (command "_.INSERT" dwg-pfad (list 0.0 0.0 0.0) 1 1 0)
      (setvar "ATTREQ" oldAttreq)
      (setvar "ATTDIA" oldAttdia)
      (setq tmpEnt (entlast))
      (setq srcAttribs (ssg-attrib-read tmpEnt))
      (command "_.ERASE" tmpEnt "")
      srcAttribs
    )
  )
)

;; Attribut eines Blocks anhand seines Handle suchen und aendern
;; handle     = Entity-Handle (String) des INSERT
;; tag        = Attributbezeichner
;; wert       = neuer Wert
;; ersetzen   = T -> ersetzen; nil -> anhaengen
(defun ssg-attrib-by-handle (handle tag wert ersetzen / e typ blk-tag blk-wert fertig)
  (setq e      (entnext)
        fertig nil
  )
  (while (and e (not fertig))
    (setq typ (cdr (assoc 0 (entget e))))
    (if (and (equal (cdr (assoc 5 (entget e))) handle)
             (equal typ "INSERT")
             (equal (cdr (assoc 66 (entget e))) 1)
        )
      (progn
        (while (not (= (cdr (assoc 0 (entget e))) "SEQEND"))
          (if (equal (cdr (assoc 0 (entget e))) "ATTRIB")
            (progn
              (setq blk-tag  (cdr (assoc 2 (entget e)))
                    blk-wert (cdr (assoc 1 (entget e)))
              )
              (if (equal blk-tag tag)
                (if ersetzen
                  (entmod (subst (cons 1 wert)
                                 (assoc 1 (entget e)) (entget e)))
                  (entmod (subst (cons 1 (strcat blk-wert wert))
                                 (assoc 1 (entget e)) (entget e)))
                )
              )
            )
          )
          (setq e (entnext e))
        )
        (setq fertig T)
      )
    )
    (setq e (entnext e))
  )
)


;; ------------------------------------------------------------
;; DIALOG-STANDARD-PATTERN
;; Vorlage fuer DCL-Dialoge: laden, initialisieren, starten
;; Verwendung:
;;   (ssg-dialog-run "pfad/dialog.dcl" "dialog-name" init-fn accept-fn)
;;
;;   init-fn   = Funktion ohne Parameter, setzt Tiles und Actions
;;   accept-fn = Funktion ohne Parameter, liest Tiles aus
;; ------------------------------------------------------------

(defun ssg-dialog-run (dcl-pfad dialog-name init-fn accept-fn / dat)
  (setq dat (load_dialog dcl-pfad))
  (if (not (new_dialog dialog-name dat))
    (progn (alert "Dialog konnte nicht geladen werden.") (exit))
  )
  (if init-fn (apply init-fn nil))
  (action_tile "accept" "(if accept-fn (apply accept-fn nil)) (done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (start_dialog)
  (unload_dialog dat)
)


;; ------------------------------------------------------------
;; ZOOM-HILFSFUNKTIONEN
;; ------------------------------------------------------------

;; Aktuelle View-Groesse merken
(defun ssg-zoom-save ()
  (setq _ssg-view-size (getvar "VIEWSIZE"))
)

;; Auf gespeicherte View-Groesse zurueckschalten (wenn veraendert)
(defun ssg-zoom-restore ()
  (if (and _ssg-view-size (/= (getvar "VIEWSIZE") _ssg-view-size))
    (command "_ZOOM" "_P")
  )
)


;; ------------------------------------------------------------
;; KONFIGURATION AUS JSON LADEN
;; Liest data/json/component_defaults.json und stellt Werte
;; ueber (ssg-cfg "section" "key") bereit.
;; Struktur: {"section": {"key": wert, ...}, ...}
;; Ergebnis: *ssg-config* = (("section" ("key" . wert) ...) ...)
;; ------------------------------------------------------------

(setq *ssg-config* nil)

;; Datei zeilenweise einlesen (wie omni:read-file-lines)
(defun ssg-read-file-lines (datei / f zeile ergebnis)
  (setq f (open datei "r"))
  (if (null f)
    nil
    (progn
      (setq ergebnis nil)
      (while (setq zeile (read-line f))
        (setq ergebnis (cons zeile ergebnis))
      )
      (close f)
      (reverse ergebnis)
    )
  )
)

;; Whitespace und Komma trimmen
(defun ssg-cfg-trim (s / len)
  (setq s (vl-string-trim " \t\r\n" s))
  (setq len (strlen s))
  (if (and (> len 0) (= (substr s len 1) ","))
    (setq s (substr s 1 (1- len)))
  )
  (vl-string-trim " \t\r\n" s)
)

;; JSON-Wert parsen (String, Zahl, null, true, false, Array)
(defun ssg-cfg-parse-value (val-str / len)
  (setq val-str (ssg-cfg-trim val-str))
  (cond
    ((= val-str "null") nil)
    ((= val-str "true") T)
    ((= val-str "false") nil)
    ;; String
    ((= (substr val-str 1 1) "\"")
      (setq len (strlen val-str))
      (if (and (> len 1) (= (substr val-str len 1) "\""))
        (substr val-str 2 (- len 2))
        val-str
      )
    )
    ;; Array [...] -> Liste von Werten parsen
    ((= (substr val-str 1 1) "[")
      (ssg-cfg-parse-array val-str)
    )
    ;; Zahl
    (T
      (if (vl-string-search "." val-str)
        (atof val-str)
        (atoi val-str)
      )
    )
  )
)

;; Einfaches JSON-Array parsen: [1, 2, 3.5, "text"]
(defun ssg-cfg-parse-array (arr-str / inhalt teile ergebnis item)
  (setq inhalt (ssg-cfg-trim arr-str))
  ;; Klammern entfernen
  (setq inhalt (substr inhalt 2 (- (strlen inhalt) 2)))
  ;; An Kommas aufteilen (einfach: kein verschachteltes Array)
  (setq teile (ssg-cfg-split-comma inhalt))
  (setq ergebnis nil)
  (foreach item teile
    (setq ergebnis (cons (ssg-cfg-parse-value item) ergebnis))
  )
  (reverse ergebnis)
)

;; String an Kommas aufteilen -> Liste von Strings
(defun ssg-cfg-split-comma (s / result current i ch)
  (setq result nil current "" i 1)
  (repeat (strlen s)
    (setq ch (substr s i 1))
    (if (= ch ",")
      (progn
        (setq result (cons current result))
        (setq current "")
      )
      (setq current (strcat current ch))
    )
    (setq i (1+ i))
  )
  (if (> (strlen (vl-string-trim " " current)) 0)
    (setq result (cons current result))
  )
  (reverse result)
)

;; Key-Value-Zeile parsen: "key": wert -> ("key" . wert)
(defun ssg-cfg-parse-kv (zeile / pos key rest pos2 val)
  (setq zeile (ssg-cfg-trim zeile))
  (if (and (> (strlen zeile) 0) (= (substr zeile 1 1) "\""))
    (progn
      (setq pos (vl-string-search "\"" zeile 1))
      (if pos
        (progn
          (setq key (substr zeile 2 (1- pos)))
          (setq rest (substr zeile (+ pos 2)))
          (setq pos2 (vl-string-search ":" rest))
          (if pos2
            (cons key (ssg-cfg-parse-value (substr rest (+ pos2 2))))
          )
        )
      )
    )
  )
)

;; --- JSON-Array von flachen Objekten parsen ---
;; Verwendet ssg-cfg-trim und ssg-cfg-parse-kv aus ssg_core.
;; Rueckgabe: Liste von Alists (("key" . wert) ...)
(defun ssg-parse-json-array (zeilen / in-obj obj ergebnis zeile kv trimmed)
  (setq in-obj nil  obj nil  ergebnis nil)
  (foreach zeile zeilen
    (setq trimmed (ssg-cfg-trim zeile))
    (cond
      ((= trimmed "{")
        (setq in-obj T  obj nil))
      ((or (= trimmed "}") (= trimmed "},"))
        (if (and in-obj obj)
          (setq ergebnis (cons (reverse obj) ergebnis)))
        (setq in-obj nil))
      (in-obj
        (setq kv (ssg-cfg-parse-kv trimmed))
        (if kv (setq obj (cons kv obj))))
    )
  )
  (reverse ergebnis)
)

;; JSON-Datei als flaches Array laden
;; Rueckgabe: Liste von Alists oder nil bei Fehler
(defun ssg-load-json (datei / zeilen)
  (setq zeilen (ssg-read-file-lines datei))
  (if zeilen (ssg-parse-json-array zeilen))
)

;; Wert aus Alist lesen: (ssg-val alist "key")
(defun ssg-val (alist key)
  (cdr (assoc key alist))
)


;; Verschachteltes JSON-Objekt parsen (1 Ebene tief)
;; {"section": {"key": val, ...}, ...}
;; -> (("section" ("key" . val) ...) ...)
(defun ssg-cfg-parse-nested (zeilen / ergebnis section section-data
                              trimmed kv in-section in-inner)
  (setq ergebnis nil
        section nil
        section-data nil
        in-section nil
        in-inner nil
  )
  (foreach zeile zeilen
    (setq trimmed (ssg-cfg-trim zeile))
    (cond
      ;; Aeusseres { oder } ignorieren (Wurzel-Objekt)
      ((and (not in-section) (= trimmed "{")) nil)
      ((and (not in-section) (= trimmed "}")) nil)

      ;; Leere Section auf einer Zeile: "name": {}
      ;; (Section-Start und -Ende zugleich - json.dump schreibt leere
      ;; Objekte immer inline, unabhaengig von der Einrueckung.)
      ((and (not in-inner)
            (>= (strlen trimmed) 2)
            (= (substr trimmed (1- (strlen trimmed)) 2) "{}"))
        (setq section (substr trimmed 2
          (1- (vl-string-search "\"" trimmed 1))))
        (setq ergebnis (cons (cons section nil) ergebnis))
      )

      ;; Section-Start: "name": {
      ((and (not in-inner) (vl-string-search ": {" trimmed))
        (setq kv (ssg-cfg-parse-kv
          (substr trimmed 1 (vl-string-search ": {" trimmed))))
        ;; kv ist hier nur der Key-Teil, der Rest ist ": {"
        ;; Einfacher: Key direkt extrahieren
        (setq section (substr trimmed 2
          (1- (vl-string-search "\"" trimmed 1))))
        (setq section-data nil)
        (setq in-section T in-inner T)
      )

      ;; Section-Ende: }
      ((and in-inner (or (= trimmed "}") (= trimmed "},")))
        (if section
          (setq ergebnis (cons (cons section (reverse section-data)) ergebnis))
        )
        (setq in-section nil in-inner nil section nil section-data nil)
      )

      ;; Key-Value innerhalb einer Section
      (in-inner
        (setq kv (ssg-cfg-parse-kv trimmed))
        (if kv (setq section-data (cons kv section-data)))
      )
    )
  )
  (reverse ergebnis)
)

;; Konfiguration laden
;; Sucht data/json/component_defaults.json ueber DXFM_DATA
(defun ssg-load-config ( / data-pfad cfg-datei zeilen)
  (setq data-pfad (getenv "DXFM_DATA"))
  (if (null data-pfad)
    (princ "\n[CFG] WARNUNG: DXFM_DATA nicht gesetzt, Config nicht geladen.")
    (progn
      (setq cfg-datei (strcat data-pfad "/json/component_defaults.json"))
      (if (not (findfile cfg-datei))
        (princ (strcat "\n[CFG] WARNUNG: " cfg-datei " nicht gefunden."))
        (progn
          (setq zeilen (ssg-read-file-lines cfg-datei))
          (if zeilen
            (progn
              (setq *ssg-config* (ssg-cfg-parse-nested zeilen))
              (princ (strcat "\n[CFG] Config geladen: "
                             (itoa (length *ssg-config*)) " Sektionen."))
            )
            (princ (strcat "\n[CFG] WARNUNG: Leere Config-Datei: " cfg-datei))
          )
        )
      )
    )
  )
  (princ)
)

;; Wert aus Config lesen: (ssg-cfg "section" "key")
;; Gibt den Wert oder nil zurueck.
(defun ssg-cfg (section key / sec-data)
  (if *ssg-config*
    (progn
      (setq sec-data (cdr (assoc section *ssg-config*)))
      (if sec-data
        (cdr (assoc key sec-data))
      )
    )
  )
)

;; Wert mit Fallback: (ssg-cfg-or "section" "key" default)
(defun ssg-cfg-or (section key default / val)
  (setq val (ssg-cfg section key))
  (if val val default)
)


;; ============================================================
;; INI-STYLE CONFIG-PARSER (Standard fuer alle cfg/*.cfg-Dateien)
;;
;; Format:
;;   [Abschnitt]
;;   Key = Wert                 (einzelner Wert)
;;   Key = Wert1, Wert2, Wert3  (kommagetrennte Liste, z.B. fuer wcmatch)
;;   # Kommentar / Leerzeile werden ignoriert
;;
;; Verwendung:
;;   (setq cfg (ssg-load-ini pfad))
;;   (ssg-ini-get  cfg "sektion" "key" "default")
;;   (ssg-ini-list cfg "sektion" "key" "a,b,c")   ; normalisiert zu "a,b,c" (wcmatch-tauglich)
;; ============================================================

;; Zeilen einer .cfg-Datei in verschachtelte Alist parsen.
;; Rueckgabe: (("sektion" ("key" . "wert") ...) ...)
(defun ssg-ini-parse-lines (zeilen / ergebnis section sec-data trimmed pos key val)
  (setq ergebnis nil  section nil  sec-data nil)
  (foreach zeile zeilen
    (setq trimmed (vl-string-trim " \t\r\n" zeile))
    (cond
      ;; Leerzeile oder Kommentar
      ((or (= trimmed "") (= (substr trimmed 1 1) "#")) nil)
      ;; Abschnitt: [name]
      ((and (= (substr trimmed 1 1) "[")
            (= (substr trimmed (strlen trimmed) 1) "]"))
        (if section
          (setq ergebnis (cons (cons section (reverse sec-data)) ergebnis)))
        (setq section (substr trimmed 2 (- (strlen trimmed) 2)))
        (setq sec-data nil)
      )
      ;; Key=Wert
      ((and section (setq pos (vl-string-search "=" trimmed)))
        (setq key (vl-string-trim " \t" (substr trimmed 1 pos)))
        (setq val (vl-string-trim " \t" (substr trimmed (+ pos 2))))
        (setq sec-data (cons (cons key val) sec-data))
      )
    )
  )
  (if section
    (setq ergebnis (cons (cons section (reverse sec-data)) ergebnis)))
  (reverse ergebnis)
)

;; .cfg-Datei laden und als verschachtelte Alist zurueckgeben, oder nil.
(defun ssg-load-ini (cfg-datei / zeilen)
  (setq zeilen (ssg-read-file-lines cfg-datei))
  (if zeilen (ssg-ini-parse-lines zeilen))
)

;; Einzelwert aus geladener INI-Alist lesen, mit Fallback.
;; ini-data = Rueckgabe von ssg-load-ini
(defun ssg-ini-get (ini-data section key default / sec-data val)
  (setq sec-data (cdr (assoc section ini-data)))
  (setq val (if sec-data (cdr (assoc key sec-data))))
  (if (and val (> (strlen val) 0)) val default)
)

;; Kommagetrennten Wert aus geladener INI-Alist lesen und normalisieren
;; (Leerzeichen um Kommas entfernen, leere Teile verwerfen).
;; default-str = Fallback als kommagetrennter String, falls Config/Key fehlt.
;; Rueckgabe: kommagetrennter String, z.B. "KR_*,KREISEL_*" (wcmatch-tauglich)
(defun ssg-ini-list (ini-data section key default-str / raw teile ergebnis item first)
  (setq raw (ssg-ini-get ini-data section key default-str))
  (setq teile (ssg-cfg-split-comma raw))
  (setq ergebnis ""  first T)
  (foreach item teile
    (setq item (vl-string-trim " \t" item))
    (if (> (strlen item) 0)
      (progn
        (setq ergebnis (if first item (strcat ergebnis "," item)))
        (setq first nil)
      )
    )
  )
  ergebnis
)


(prompt "\nssg_core.lsp geladen.")
(princ)