;; ============================================================
;; Gefaellestrecke.lsp - Gefaelle-Foerderanlage Generator
;; v2.0 - Standalone-Modul
;;
;; Modus 1: Manuelle Werteingabe (einfache Gefaellestrecke)
;; Modus 2: 3D-Linie als Referenz
;; Modus 3: Linienzug aus LINE- und ARC-Objekten
;;          ARC-Segmente werden durch Gefaellebogen-Bloecke ersetzt.
;;          Vor jedem Bogen wird automatisch ein Separator eingefuegt.
;;          Gefaellewinkel wird aus deltaH und Geometrie berechnet.
;;
;; Verfuegbare Gefaellebogen-Bloecke (aus data/ils/3D/ als einzelne DWG):
;;   Gefaellebogen_links_30(Grad)_R500   (30 Grad Linkskurve)
;;   Gefaellebogen_links_60(Grad)_R500   (60 Grad Linkskurve)
;;   Gefaellebogen_links_90(Grad)_R500   (90 Grad Linkskurve)
;;   Gefaellebogen_rechts_30(Grad)_R500  (30 Grad Rechtskurve)
;;   Gefaellebogen_rechts_60(Grad)_R500  (60 Grad Rechtskurve)
;;   Gefaellebogen_rechts_90(Grad)_R500  (90 Grad Rechtskurve)
;;
;; Befehl: GEFAELLESTRECKE
;; ============================================================

(vl-load-com)

;; ============================================================
;; TEIL 1: INITIALISIERUNG
;; ============================================================

(if (null grad-zeichen) (setq grad-zeichen (chr 176)))
(if (null delta-sym)   (setq delta-sym    (chr 916)))

(if (null *gf-ks-cache*)   (setq *gf-ks-cache*   nil))
(if (null *gf-lib-geladen*)(setq *gf-lib-geladen* nil))

;; COM-Objekte (Guard: nicht ueberschreiben wenn von vf_core gesetzt)
(if (null doc)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(if (null modelspace)
  (setq modelspace (vla-get-ModelSpace doc)))

;; Fallback-Werte fuer AS/ES-Blockabmessungen (Modus 1+2)
;; Werden von vf_standard.lsp ueberschrieben, falls geladen.
(if (null aus-dx) (setq aus-dx 526.0))
(if (null ein-dx) (setq ein-dx 576.0))
;; Z-Versatz KS_EIN->KS_AUS in Neutrallage (positiv = nach unten)
;; Werden in gf-init-bibliothek gemessen.
(if (null aus-dz) (setq aus-dz 0.0))
(if (null ein-dz) (setq ein-dz 0.0))
;; Lokale KS_EIN-Positionen (Blockursprung-relative Koordinaten, fuer Modus 3)
;; Werden in init-bibliothek gesetzt.
(if (null *aus-ks-ein-local*) (setq *aus-ks-ein-local* nil))
(if (null *ein-ks-ein-local*) (setq *ein-ks-ein-local* nil))
(if (null *lib-initialized*)  (setq *lib-initialized*  nil))
;; Laufende GF-Blocknummer (sitzungspersistent)
(if (null #GF_LetzteNr) (setq #GF_LetzteNr 0))
;; Hilfs-Globals fuer Winkelkorrektur (gesetzt von gf-winkel-berechnen)
(if (null *gf-L-ohne-as-es*)  (setq *gf-L-ohne-as-es*  nil))
(if (null *gf-sum-dz-bogen*)  (setq *gf-sum-dz-bogen*  0.0))

;; DXFM_DIM lesen; 2D wird auf 3D korrigiert (Gefaellestrecke benoetigt Z-Geometrie)
(setq *gf-dxfm-dim* (getenv "DXFM_DIM"))
(if (or (not (= (type *gf-dxfm-dim*) 'STR)) (= *gf-dxfm-dim* "2D"))
  (setq *gf-dxfm-dim* "3D"))
;; Block-Pfad: data/ils/3D/ wenn DXFM_DIM nicht gesetzt oder 2D
(if (null block-pfad)
  (setq block-pfad
    (cond
      ((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
       (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
               "/data/ils/" *gf-dxfm-dim* "/"))
      ((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/" *gf-dxfm-dim* "/"))
      (t nil)
    )
  )
)

;; ============================================================
;; TEIL 2: KERN-FUNKTIONEN (Guard: nicht doppelt definieren)
;; ============================================================

;; --- ssg-cfg-or Ersatz ---
(if (null (car (atoms-family 1 '("SSG-CFG-OR"))))
  (defun ssg-cfg-or (kategorie schluessel standard) standard)
)

;; --- Vektor-Laenge ---
(if (null (car (atoms-family 1 '("VEC-LENGTH"))))
  (defun vec-length (v)
    (sqrt (+ (* (car v) (car v))
             (* (cadr v) (cadr v))
             (* (caddr v) (caddr v)))))
)

;; --- Achsenkennung aus Linienlaenge fuer KS-Extraktion ---
(if (null (car (atoms-family 1 '("KS-LINE-AXIS"))))
  (defun ks-line-axis (len)
    (cond
      ((and (> len 0.5) (< len 1.5)) "X")
      ((and (> len 99)  (< len 101)) "X")
      ((and (> len 1.5) (< len 2.5)) "Y")
      ((and (> len 2.5) (< len 3.5)) "Z")
      (t nil)))
)

;; --- Punkt-Differenz ---
(if (null (car (atoms-family 1 '("PUNKT-DIFFERENZ"))))
  (defun punkt-differenz (p1 p2)
    (list (- (car p2) (car p1))
          (- (cadr p2) (cadr p1))
          (- (caddr p2) (caddr p1))))
)

;; --- Block als einzelne DWG-Datei aus block-pfad laden ---
(if (null (car (atoms-family 1 '("ENSURE-BLOCK-LOADED"))))
  (defun ensure-block-loaded (blockname / block-datei temp-obj)
    (if (not (tblsearch "BLOCK" blockname))
      (progn
        (setq block-datei (strcat block-pfad blockname ".dwg"))
        (if (findfile block-datei)
          (progn
            (princ (strcat "\n  Lade Block: " blockname " ..."))
            (setq temp-obj
              (vla-InsertBlock modelspace
                (vlax-3D-point '(0 0 0))
                block-datei 1.0 1.0 1.0 0))
            (vla-Delete temp-obj)
            (princ " OK")
          )
          (princ (strcat "\n  FEHLER: Block-Datei nicht gefunden: " block-datei))
        )
      )
    )
  )
)

;; --- Rohe KS-Extraktion aus Block ---
(if (null (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK-RAW"))))
  (defun extract-ks-from-block-raw (block-obj /
                                     sub-entities sub-obj ks-results ks-ref
                                     inner-entities inner-obj
                                     origin x-end y-end z-end
                                     line-start line-end line-vec line-len axis)
    (setq ks-results '())
    (setq sub-entities (vlax-invoke block-obj 'Explode))
    (foreach sub-obj sub-entities
      ;; KS-Blocknamen normalisieren: aeltere Bloecke nutzen KS_EIN/KS_AUS,
      ;; Vario_Kurve-Bloecke KSYS_EIN/KSYS_AUS (inline, damit diese Fallback-
      ;; Kopie unabhaengig von vf_core.lsp funktioniert).
      (setq ks-ref
        (if (and (not (vlax-erased-p sub-obj))
                 (= (vla-get-ObjectName sub-obj) "AcDbBlockReference"))
          (cond
            ((or (= (vla-get-Name sub-obj) "KS_EIN")  (= (vla-get-Name sub-obj) "KSYS_EIN")) "KS_EIN")
            ((or (= (vla-get-Name sub-obj) "KS_AUS")  (= (vla-get-Name sub-obj) "KSYS_AUS")) "KS_AUS")
            (t nil))
          nil))
      (if ks-ref
        (progn
          (setq inner-entities (vlax-invoke sub-obj 'Explode))
          (setq origin nil x-end nil y-end nil z-end nil)
          (foreach inner-obj inner-entities
            (if (and (not (vlax-erased-p inner-obj))
                     (= (vla-get-ObjectName inner-obj) "AcDbLine"))
              (progn
                (setq line-start
                  (vlax-safearray->list
                    (vlax-variant-value (vla-get-StartPoint inner-obj))))
                (setq line-end
                  (vlax-safearray->list
                    (vlax-variant-value (vla-get-EndPoint inner-obj))))
                (setq line-vec
                  (list (- (car line-end) (car line-start))
                        (- (cadr line-end) (cadr line-start))
                        (- (caddr line-end) (caddr line-start))))
                (setq line-len (vec-length line-vec))
                (setq axis (ks-line-axis line-len))
                (if (null origin) (setq origin line-start))
                (cond
                  ((= axis "X") (setq x-end line-end))
                  ((= axis "Y") (setq y-end line-end))
                  ((= axis "Z") (setq z-end line-end))
                )
              )
            )
            (if (not (vlax-erased-p inner-obj)) (vla-Delete inner-obj))
          )
          (if (and origin x-end y-end z-end)
            (setq ks-results
              (cons (list ks-ref (list origin x-end y-end z-end))
                    ks-results))
          )
        )
      )
    )
    (foreach sub-obj sub-entities
      (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj))
    )
    ks-results
  )
)

;; --- KS-Extraktion mit Cache ---
(if (null (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK"))))
  (defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel)
    (setq blockname  (vla-get-Name block-obj))
    (setq insert-pt  (vlax-safearray->list
                       (vlax-variant-value
                         (vla-get-InsertionPoint block-obj))))
    (setq cached (assoc blockname *gf-ks-cache*))
    (if cached
      ;; Aus Cache: relative Koordinaten + Einfuegepunkt
      (mapcar '(lambda (item)
        (list (car item)
              (mapcar '(lambda (pt)
                (list (+ (car pt)   (car insert-pt))
                      (+ (cadr pt)  (cadr insert-pt))
                      (+ (caddr pt) (caddr insert-pt))))
                (cadr item))))
        (cdr cached))
      (progn
        (setq result (extract-ks-from-block-raw block-obj))
        (if result
          (progn
            (setq ks-rel
              (mapcar '(lambda (item)
                (list (car item)
                      (mapcar '(lambda (pt)
                        (list (- (car pt)   (car insert-pt))
                              (- (cadr pt)  (cadr insert-pt))
                              (- (caddr pt) (caddr insert-pt))))
                        (cadr item))))
                result))
            (setq *gf-ks-cache*
              (cons (cons blockname ks-rel) *gf-ks-cache*))
          )
        )
        result
      )
    )
  )
)

;; --- Block per KS_EIN/KS_AUS einfuegen ---
(if (null (car (atoms-family 1 '("INSERT-BLOCK-BY-KS"))))
  (defun insert-block-by-ks (blockname einfuegepunkt hz /
                               block-obj temp-obj ks-data ks-ein ks-aus
                               rad-h chv shv ein-x ein-y ein-z dx-loc dy-loc dz-loc
                               offset ausgang)
    (ensure-block-loaded blockname)
    (if (not (tblsearch "BLOCK" blockname))
      (progn
        (princ (strcat "\n  FEHLER: Block '" blockname "' fehlt"))
        (exit)
      )
    )
    (setq rad-h (* (float hz) (/ pi 180.0)))
    (setq chv (cos rad-h) shv (sin rad-h))
    ;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht
    ;; am spaeter tatsaechlich platzierten block-obj), siehe vf_core.lsp.
    (setq temp-obj
      (vla-InsertBlock modelspace
        (vlax-3D-point '(0 0 0))
        blockname 1.0 1.0 1.0 0))
    (setq ks-data (extract-ks-from-block temp-obj))
    (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
    (setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
    (setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
    (setq block-obj
      (vla-InsertBlock modelspace
        (vlax-3D-point '(0 0 0))
        blockname 1.0 1.0 1.0 0))
    (vla-TransformBy block-obj (vlax-tmatrix
      (list (list chv (- shv) 0 0)
            (list shv   chv   0 0)
            (list 0      0    1 0)
            (list 0      0    0 1))))
    (if (and ks-ein ks-aus)
      (progn
        (setq ein-x (car (car ks-ein)) ein-y (cadr (car ks-ein)) ein-z (caddr (car ks-ein)))
        (setq offset (list
          (- (car   einfuegepunkt) (- (* chv ein-x) (* shv ein-y)))
          (- (cadr  einfuegepunkt) (+ (* shv ein-x) (* chv ein-y)))
          (- (caddr einfuegepunkt) ein-z)))
        (vla-Move block-obj
          (vlax-3D-point '(0 0 0))
          (vlax-3D-point offset))
        (setq dx-loc (- (car   (car ks-aus)) ein-x))
        (setq dy-loc (- (cadr  (car ks-aus)) ein-y))
        (setq dz-loc (- (caddr (car ks-aus)) ein-z))
        (setq ausgang (list
          (+ (car   einfuegepunkt) (- (* chv dx-loc) (* shv dy-loc)))
          (+ (cadr  einfuegepunkt) (+ (* shv dx-loc) (* chv dy-loc)))
          (+ (caddr einfuegepunkt) dz-loc)))
        (princ (strcat "\n    KS_AUS Z=" (rtos (caddr ausgang) 2 2)))
        ausgang
      )
      (progn
        (princ "\n  WARNUNG: KS_EIN/KS_AUS fehlt!")
        einfuegepunkt
      )
    )
  )
)

;; --- Skalierter geneigter Block (Staustrecke, Richtung X) ---
(if (null (car (atoms-family 1 '("INSERT-INCLINED-SCALED-BLOCK"))))
  (defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz /
                                        rad-v rad-h chv shv cvv svv scale block-obj endpunkt)
    (if (<= laenge 0.1)
      (progn (princ "\n  (Laenge 0 - uebersprungen)") startpunkt)
      (progn
        (ensure-block-loaded blockname)
        (setq scale (/ (float laenge) 1000.0))
        (setq rad-v (* (float winkel) (/ pi 180.0)))
        (setq rad-h (* (float hz)     (/ pi 180.0)))
        (setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v))
        (setq block-obj
          (vla-InsertBlock modelspace
            (vlax-3D-point '(0 0 0))
            blockname scale 1.0 1.0 0))
        (vla-TransformBy block-obj (vlax-tmatrix
          (list (list (* chv cvv) (- shv) (* chv svv) 0)
                (list (* shv cvv)   chv   (* shv svv) 0)
                (list (- svv)        0      cvv        0)
                (list 0 0 0 1))))
        (vla-Move block-obj
          (vlax-3D-point '(0 0 0))
          (vlax-3D-point startpunkt))
        (setq endpunkt
          (list (+ (car   startpunkt) (* laenge chv cvv))
                (+ (cadr  startpunkt) (* laenge shv cvv))
                (+ (caddr startpunkt) (* laenge (- svv)))))
        (princ (strcat "\n    " blockname " L=" (rtos laenge 2 1)
                       " -> Z=" (rtos (caddr endpunkt) 2 1)))
        endpunkt
      )
    )
  )
)

;; --- Rotierter Block mit manuellem dx/dz ---
;; KS_EIN (nicht der Block-Ursprung) wird auf startpunkt ausgerichtet, siehe
;; Kommentar an der kanonischen Definition in vf_core.lsp.
(if (null (car (atoms-family 1 '("INSERT-ROTATED-BLOCK-WITH-KS"))))
  ;; block-dx/block-dz: Fallback, nur falls KS_AUS nicht extrahierbar.
  ;; Ist KS_AUS vorhanden, wird der echte Versatz KS_AUS-KS_EIN verwendet
  ;; (schuetzt vor veralteten Config-Zahlen), siehe vf_core.lsp.
  (defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz hz /
                                        rad-v rad-h chv shv cvv svv block-obj temp-obj ks-data
                                        ks-ein-raw ks-aus-raw
                                        ein-x ein-y ein-z aus-x aus-y aus-z
                                        dx dz ins-pt)
    (ensure-block-loaded blockname)
    (setq rad-v (* (float winkel) (/ pi 180.0)))
    (setq rad-h (* (float hz)     (/ pi 180.0)))
    (setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v))
    ;; Lokale KS_EIN/KS_AUS-Position ueber EIGENES Temp-Objekt ermitteln
    ;; (nicht am spaeter tatsaechlich platzierten block-obj), siehe vf_core.lsp.
    (setq temp-obj
      (vla-InsertBlock modelspace
        (vlax-3D-point '(0 0 0))
        blockname 1.0 1.0 1.0 0))
    (setq ks-data    (extract-ks-from-block temp-obj))
    (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
    (setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data)))
    (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
    (setq ein-x 0.0 ein-y 0.0 ein-z 0.0)
    (if ks-ein-raw
      (setq ein-x (car   (car ks-ein-raw))
            ein-y (cadr  (car ks-ein-raw))
            ein-z (caddr (car ks-ein-raw)))
    )
    (setq dx block-dx  dz block-dz)
    (if ks-aus-raw
      (progn
        (setq aus-x (car   (car ks-aus-raw))
              aus-y (cadr  (car ks-aus-raw))
              aus-z (caddr (car ks-aus-raw)))
        (setq dx (- aus-x ein-x)  dz (- aus-z ein-z))
      )
    )
    (setq block-obj
      (vla-InsertBlock modelspace
        (vlax-3D-point '(0 0 0))
        blockname 1.0 1.0 1.0 0))
    (vla-TransformBy block-obj (vlax-tmatrix
      (list (list (* chv cvv) (- shv) (* chv svv) 0)
            (list (* shv cvv)   chv   (* shv svv) 0)
            (list (- svv)        0      cvv        0)
            (list 0 0 0 1))))
    (setq ins-pt (list
      (- (car   startpunkt) (+ (* ein-x chv cvv) (* ein-y (- shv)) (* ein-z chv svv)))
      (- (cadr  startpunkt) (+ (* ein-x shv cvv) (* ein-y    chv)  (* ein-z shv svv)))
      (- (caddr startpunkt) (+ (* ein-x (- svv))                   (* ein-z    cvv)))))
    (vla-Move block-obj
      (vlax-3D-point '(0 0 0))
      (vlax-3D-point ins-pt))
    (list
      (+ (car startpunkt)   (+ (* dx chv cvv) (* dz chv svv)))
      (+ (cadr startpunkt)  (+ (* dx shv cvv) (* dz shv svv)))
      (+ (caddr startpunkt) (+ (* dx (- svv)) (* dz cvv))))
  )
)

;; --- KS-Rahmen aus Fahrtrichtungsvektor (Fallback wenn vf_core nicht geladen) ---
(if (null (car (atoms-family 1 '("MAKE-FRAME-FROM-DIR"))))
  (defun make-frame-from-dir (P xu-unit / hlen yu zu)
    (setq hlen (sqrt (+ (* (car  xu-unit)(car  xu-unit))
                        (* (cadr xu-unit)(cadr xu-unit)))))
    (setq yu
      (if (> hlen 1e-6)
        (list (/ (- (cadr xu-unit)) hlen) (/ (car xu-unit) hlen) 0.0)
        '(1.0 0.0 0.0)))
    (setq zu
      (list (- (* (cadr  xu-unit)(caddr yu)) (* (caddr xu-unit)(cadr  yu)))
            (- (* (caddr xu-unit)(car   yu)) (* (car   xu-unit)(caddr yu)))
            (- (* (car   xu-unit)(cadr  yu)) (* (cadr  xu-unit)(car   yu)))))
    (list P xu-unit yu zu))
)

;; --- Linie/Polylinie-Endpunkte lesen ---
(if (null (car (atoms-family 1 '("GET-LINE-START-END-POINTS"))))
  (defun get-line-start-end-points (msg / ent obj obj-name sp ep)
    (princ msg)
    (setq ent (entsel "\n  >> Linie waehlen: "))
    (if ent
      (progn
        (setq obj (vlax-ename->vla-object (car ent)))
        (setq obj-name (vla-get-ObjectName obj))
        (cond
          ((= obj-name "AcDbLine")
           (setq sp (vlax-safearray->list
                      (vlax-variant-value (vla-get-StartPoint obj))))
           (setq ep (vlax-safearray->list
                      (vlax-variant-value (vla-get-EndPoint obj))))
           (princ (strcat "\n  3D-Linie: Z_start=" (rtos (caddr sp) 2 2)
                          "  Z_end=" (rtos (caddr ep) 2 2)))
           (list sp ep)
          )
          (t (princ "\n  Fehler: keine Linie!") nil)
        )
      )
      nil
    )
  )
)

;; --- Bibliothek initialisieren: AS/ES-Masse aus einzelnen DWG-Dateien extrahieren ---
(if (null (car (atoms-family 1 '("GF-INIT-BIBLIOTHEK"))))
  (defun gf-init-bibliothek ( / temp-obj ks-data ks-ein ks-aus)
    (if *lib-initialized*
      t
      (progn
        ;; AS-Block laden und Masse extrahieren
        (ensure-block-loaded "AS_Element_90_links")
        (if (tblsearch "BLOCK" "AS_Element_90_links")
          (progn
            (setq temp-obj
              (vla-InsertBlock modelspace
                (vlax-3D-point '(0 0 0))
                "AS_Element_90_links" 1.0 1.0 1.0 0))
            (setq ks-data (extract-ks-from-block temp-obj))
            (vla-Delete temp-obj)
            (setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
            (setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
            (if (and ks-ein ks-aus)
              (progn
                (setq aus-dx (- (caar ks-aus) (caar ks-ein)))
                (setq aus-dz (- (caddr (car ks-ein)) (caddr (car ks-aus))))
                (setq *aus-ks-ein-local* (car ks-ein))
              )
            )
          )
        )
        ;; ES-Block laden und Masse extrahieren
        (ensure-block-loaded "ES_Element_90_links")
        (if (tblsearch "BLOCK" "ES_Element_90_links")
          (progn
            (setq temp-obj
              (vla-InsertBlock modelspace
                (vlax-3D-point '(0 0 0))
                "ES_Element_90_links" 1.0 1.0 1.0 0))
            (setq ks-data (extract-ks-from-block temp-obj))
            (vla-Delete temp-obj)
            (setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
            (setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
            (if (and ks-ein ks-aus)
              (progn
                (setq ein-dx (- (caar ks-aus) (caar ks-ein)))
                (setq ein-dz (- (caddr (car ks-ein)) (caddr (car ks-aus))))
                (setq *ein-ks-ein-local* (car ks-ein))
              )
            )
          )
        )
        (princ (strcat "\n[GF-Lib] AS: dx=" (rtos (float aus-dx) 2 1)
                       " dz=" (rtos (float aus-dz) 2 1)))
        (princ (strcat "\n[GF-Lib] ES: dx=" (rtos (float ein-dx) 2 1)
                       " dz=" (rtos (float ein-dz) 2 1)))
        (setq *lib-initialized* t)
        (setq *gf-lib-geladen* t)
        t
      )
    )
  )
)

;; ============================================================
;; TEIL 3: HZ-ROTATIONS-EINFUEGEFUNKTIONEN (fuer Modus 3)
;;
;; Transformationsmatrix: Rz(hz) * Ry(-vert)
;;   [ cos(hz)*cos(v)  -sin(hz)  cos(hz)*sin(v)  0 ]
;;   [ sin(hz)*cos(v)   cos(hz)  sin(hz)*sin(v)  0 ]
;;   [ -sin(v)          0        cos(v)           0 ]
;;   [ 0                0        0                1 ]
;; ============================================================

;; Staustrecke skaliert mit Hz-Rotation + Gefaelleneigung
;; laenge: Schraeglaenge in mm
;; hz-grad: Horizontalwinkel in Grad (0=+X, CCW)
;; vert-grad: Neigungswinkel in Grad (positiv = abwaerts)
(defun gf-insert-hz-incl-scaled (blockname pt laenge hz-grad vert-grad /
                                   chz shz cv sv scale block-obj endpunkt)
  (if (<= laenge 0.1)
    (progn (princ "\n  (Laenge 0 - uebersprungen)") pt)
    (progn
      (ensure-block-loaded blockname)
      (setq scale (/ (float laenge) 1000.0))
      (setq chz (cos (* (float hz-grad)   (/ pi 180.0))))
      (setq shz (sin (* (float hz-grad)   (/ pi 180.0))))
      (setq cv  (cos (* (float vert-grad) (/ pi 180.0))))
      (setq sv  (sin (* (float vert-grad) (/ pi 180.0))))
      (setq block-obj
        (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0))
          blockname scale 1.0 1.0 0))
      (vla-TransformBy block-obj (vlax-tmatrix
        (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))))
      (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point pt))
      (setq endpunkt
        (list (+ (car pt)   (* laenge chz cv))
              (+ (cadr pt)  (* laenge shz cv))
              (+ (caddr pt) (* (- sv) laenge))))
      (princ (strcat "\n    HzIncl " blockname
                     " L=" (rtos laenge 2 0)
                     " hz=" (rtos hz-grad 2 0) grad-zeichen
                     " v=" (rtos vert-grad 2 1) grad-zeichen
                     " -> Z=" (rtos (caddr endpunkt) 2 1)))
      endpunkt
    )
  )
)

;; Block mit Hz + Neigung, Endpunkt per manuellem dx/dz
;; dx: Laenge entlang Vorwaertsrichtung (mm)
;; dz: vertikaler Offset im Block (mm, 0 fuer gerade Bloecke)
(defun gf-insert-hz-with-ks (blockname pt hz-grad vert-grad dx dz /
                               chz shz cv sv block-obj endpunkt)
  (ensure-block-loaded blockname)
  (setq chz (cos (* (float hz-grad)   (/ pi 180.0))))
  (setq shz (sin (* (float hz-grad)   (/ pi 180.0))))
  (setq cv  (cos (* (float vert-grad) (/ pi 180.0))))
  (setq sv  (sin (* (float vert-grad) (/ pi 180.0))))
  (setq block-obj
    (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0))
      blockname 1.0 1.0 1.0 0))
  (vla-TransformBy block-obj (vlax-tmatrix
    (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))))
  (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point pt))
  (setq endpunkt
    (list (+ (car pt)   (+ (* dx chz cv) (* dz chz sv)))
          (+ (cadr pt)  (+ (* dx shz cv) (* dz shz sv)))
          (+ (caddr pt) (+ (* (- sv) dx) (* cv dz)))))
  (princ (strcat "\n    HzKS " blockname
                 " hz=" (rtos hz-grad 2 0) grad-zeichen
                 " v=" (rtos vert-grad 2 1) grad-zeichen
                 " -> Z=" (rtos (caddr endpunkt) 2 1)))
  endpunkt
)

;; Gefaellebogen-Block per KS_EIN/KS_AUS einfuegen.
;; Nur Hz-Rotation (vert=0): Block hat eigene 3D-Geometrie fuer die Neigung.
;; hz-grad: Eingangsrichtung in Grad
(defun gf-insert-gefaellebogen-by-ks (blockname pt hz-grad /
                                        chz shz
                                        temp-obj block-obj ks-data ks-ein ks-aus
                                        p-ein p-aus p-ein-rot p-aus-rot
                                        offset ausgang)
  (ensure-block-loaded blockname)
  (if (not (tblsearch "BLOCK" blockname))
    (progn
      (princ (strcat "\n  FEHLER: Block '" blockname "' fehlt!"))
      (exit)
    )
  )
  (setq chz (cos (* (float hz-grad) (/ pi 180.0))))
  (setq shz (sin (* (float hz-grad) (/ pi 180.0))))
  ;; KS-Daten bei hz=0 (Block am Ursprung)
  (setq temp-obj
    (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0))
      blockname 1.0 1.0 1.0 0))
  (setq ks-data (extract-ks-from-block temp-obj))
  (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
  (setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
  (setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
  ;; Block einfuegen und nur um Z-Achse drehen (Rz)
  (setq block-obj
    (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0))
      blockname 1.0 1.0 1.0 0))
  (vla-TransformBy block-obj (vlax-tmatrix
    (list (list chz  (- shz) 0 0)
          (list shz    chz   0 0)
          (list 0       0    1 0)
          (list 0       0    0 1))))
  (if (and ks-ein ks-aus)
    (progn
      (setq p-ein (car ks-ein))
      (setq p-aus (car ks-aus))
      ;; Rz auf KS-Punkte anwenden (Z bleibt unveraendert)
      (setq p-ein-rot
        (list (- (* chz (car p-ein)) (* shz (cadr p-ein)))
              (+ (* shz (car p-ein)) (* chz (cadr p-ein)))
              (caddr p-ein)))
      (setq p-aus-rot
        (list (- (* chz (car p-aus)) (* shz (cadr p-aus)))
              (+ (* shz (car p-aus)) (* chz (cadr p-aus)))
              (caddr p-aus)))
      ;; Block verschieben: rotiertes KS_EIN -> pt
      (vla-Move block-obj (vlax-3D-point p-ein-rot) (vlax-3D-point pt))
      (setq offset
        (list (- (car pt)   (car p-ein-rot))
              (- (cadr pt)  (cadr p-ein-rot))
              (- (caddr pt) (caddr p-ein-rot))))
      (setq ausgang
        (list (+ (car p-aus-rot)   (car offset))
              (+ (cadr p-aus-rot)  (cadr offset))
              (+ (caddr p-aus-rot) (caddr offset))))
      (princ (strcat "\n    Gefaellebogen " blockname
                     " hz=" (rtos hz-grad 2 0) grad-zeichen
                     " -> Z=" (rtos (caddr ausgang) 2 1)))
      ausgang
    )
    (progn
      (princ (strcat "\n  WARNUNG: KS fehlt in '" blockname "'"))
      pt
    )
  )
)

;; ============================================================
;; TEIL 4: MODUS 3 - LINIENZUG-ANALYSE
;; ============================================================

;; Horizontalwinkel von p1 nach p2 (Grad, 0=+X, CCW positiv)
(defun gf-hz-winkel (p1 p2)
  (* (atan (- (cadr p2) (cadr p1))
           (- (car p2)  (car p1)))
     (/ 180.0 pi)))

;; 2D-Abstand (XY-Ebene)
(defun gf-abstand-2d (p1 p2)
  (sqrt (+ (* (- (car p2)  (car p1))  (- (car p2)  (car p1)))
           (* (- (cadr p2) (cadr p1)) (- (cadr p2) (cadr p1))))))

;; Bogensweep (Grad, positiv) -> naechster Gefaellebogen-Winkel
(defun gf-snap-bogenwinkel (d)
  (cond ((< d 45) 30)
        ((< d 75) 60)
        (t 90)))

;; Blockname fuer Gefaellebogen
(defun gf-bogen-blockname (bwinkel bseite)
  (strcat "Gefaellebogen_" bseite "_" (itoa bwinkel) "_R500"))

;; dx und dz eines Gefaellebogen-Blocks extrahieren (KS_EIN -> KS_AUS)
;; Rueckgabe: (dx dz)  dx = horizontale, dz = vertikale Verschiebung
(defun gf-bogen-masse (bwinkel bseite /
                        blockname temp-obj ks-data
                        ks-ein-pos ks-aus-pos dx dz)
  (setq blockname (gf-bogen-blockname bwinkel bseite))
  (ensure-block-loaded blockname)
  (if (not (tblsearch "BLOCK" blockname))
    (progn
      (princ (strcat "\n  WARNUNG: " blockname " fehlt - Nullwerte"))
      '(0 0)
    )
    (progn
      (setq temp-obj
        (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0))
          blockname 1.0 1.0 1.0 0))
      (setq ks-data (extract-ks-from-block temp-obj))
      (vla-Delete temp-obj)
      (setq ks-ein-pos nil  ks-aus-pos nil)
      (foreach item ks-data
        (if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
        (if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
      )
      (if (and ks-ein-pos ks-aus-pos)
        (progn
          (setq dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
          (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
          (princ (strcat "\n  " blockname
                         ": dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1)))
          (list dx dz)
        )
        (progn
          (princ (strcat "\n  WARNUNG: KS fehlt in " blockname))
          '(0 0)
        )
      )
    )
  )
)

;; Verbundene Objektkette sortieren ab startpunkt.
;; Rueckgabe: Liste von (obj sp ep umgekehrt)
;;   umgekehrt=t wenn Objekt rueckwaerts traversiert wird
(defun gf-sortiere-objekte (obj-liste startpunkt /
                              kette aktuell rest
                              best best-d best-sp best-ep best-umk
                              item objname sp ep d1 d2)
  (setq kette   '())
  (setq aktuell startpunkt)
  (setq rest    obj-liste)
  (while rest
    (setq best nil  best-d 1e99)
    (foreach item rest
      (setq objname (vla-get-ObjectName item))
      (if (or (= objname "AcDbLine") (= objname "AcDbArc"))
        (progn
          (setq sp (vlax-safearray->list
                     (vlax-variant-value (vla-get-StartPoint item))))
          (setq ep (vlax-safearray->list
                     (vlax-variant-value (vla-get-EndPoint item))))
          (setq d1 (gf-abstand-2d aktuell sp))
          (setq d2 (gf-abstand-2d aktuell ep))
          (if (< d1 best-d)
            (setq best item  best-d d1
                  best-sp sp  best-ep ep  best-umk nil)
          )
          (if (< d2 best-d)
            (setq best item  best-d d2
                  best-sp ep  best-ep sp  best-umk t)
          )
        )
      )
    )
    (if best
      (progn
        (setq kette
          (append kette (list (list best best-sp best-ep best-umk))))
        (setq aktuell best-ep)
        (setq rest (vl-remove best rest))
      )
      (progn
        (princ "\n  WARNUNG: Kette unterbrochen!")
        (setq rest nil)
      )
    )
  )
  kette
)

;; Kette analysieren -> Segment-Daten
;; Segment: (typ hz-eingang laenge-2d bogen-winkel seite)
;;   typ: "Linie" oder "Bogen"
;;   hz-eingang: Horizontalwinkel bei Eintritt (Grad)
;;   laenge-2d: 2D XY-Laenge (fuer LINE), Sehnenmass (fuer ARC)
;;   bogen-winkel: 30/60/90 (nur fuer Bogen)
;;   seite: "links"/"rechts" (nur fuer Bogen)
(defun gf-analysiere-kette (kette /
                              segmente item obj objname sp ep umk
                              hz start-a end-a sweep delta
                              bwinkel bseite prev-hz)
  (setq segmente '())
  (setq prev-hz  nil)
  (foreach item kette
    (setq obj     (car item))
    (setq sp      (cadr item))
    (setq ep      (caddr item))
    (setq umk     (nth 3 item))
    (setq objname (vla-get-ObjectName obj))
    (cond
      ((= objname "AcDbLine")
       (setq hz (gf-hz-winkel sp ep))
       (setq segmente
         (append segmente
           (list (list "Linie" hz (gf-abstand-2d sp ep) 0 "links"))))
       (setq prev-hz hz)
      )
      ((= objname "AcDbArc")
       ;; Sweep des Bogens in Grad (immer positiv, CCW)
       (setq start-a (vla-get-StartAngle obj))
       (setq end-a   (vla-get-EndAngle   obj))
       (if (>= end-a start-a)
         (setq sweep (* (- end-a start-a) (/ 180.0 pi)))
         (setq sweep (* (+ (* 2 pi) (- end-a start-a)) (/ 180.0 pi)))
       )
       ;; Traversierungsrichtung: vorwaerts=CCW=Linkskurve, rueckwaerts=CW=Rechtskurve
       (if umk
         (setq delta (- sweep))
         (setq delta sweep)
       )
       (setq bwinkel (gf-snap-bogenwinkel (abs delta)))
       (setq bseite  (if (>= delta 0) "links" "rechts"))
       ;; Eingangsrichtung: vorheriger Richtungswinkel (oder Chord-Winkel)
       (setq hz (if prev-hz prev-hz (gf-hz-winkel sp ep)))
       (setq segmente
         (append segmente
           (list (list "Bogen" hz (gf-abstand-2d sp ep) bwinkel bseite))))
       ;; Ausgangsrichtung nach dem Bogen
       (setq prev-hz
         (+ hz (* (if (>= delta 0) 1.0 -1.0) (float bwinkel))))
      )
    )
  )
  segmente
)

;; Gefaellewinkel (Grad) aus Segmentliste und deltaH berechnen.
;; deltaH: positiver Hoehenunterschied in mm (Gesamt-Abfall)
;; extra-sep: zusaetzliche Separatoren ausserhalb der Bogen (z.B. 1 vor EIN-Element)
;; Formel (Naeherung): sin(v) = (deltaH - aus-dz - ein-dz - sum(|dz_bogen|))
;;                             / (L_gerade + aus-dx + ein-dx + sum(dx_bogen))
;; Setzt Globals fuer Korrekturschritt:
;;   *gf-L-ohne-as-es*   - Laenge ohne AS/ES-dx (fuer gemessene Korrektur)
;;   *gf-sum-dz-bogen*   - Summe dz-Anteile der Bogen
(defun gf-winkel-berechnen (segmente deltaH extra-sep /
                              L-gerade sum-dz-bogen sum-dx-bogen n-bogen
                              seg bwinkel bseite masse sin-alpha alpha deltaH-eff)
  (setq L-gerade 0.0  sum-dz-bogen 0.0  sum-dx-bogen 0.0  n-bogen 0)
  (foreach seg segmente
    (if (= (car seg) "Linie")
      (setq L-gerade (+ L-gerade (caddr seg)))
      (progn
        (setq bwinkel (nth 3 seg)  bseite (nth 4 seg))
        (setq masse (gf-bogen-masse bwinkel bseite))
        (setq sum-dx-bogen (+ sum-dx-bogen (car  masse)))
        (setq sum-dz-bogen (+ sum-dz-bogen (abs (cadr masse))))
        (setq n-bogen (1+ n-bogen))
      )
    )
  )
  ;; Separator (300mm): je einen vor jedem Bogen + extra-sep weitere
  (setq L-gerade (+ L-gerade (* (+ (float n-bogen) (float extra-sep)) 300.0)))
  ;; L ohne AS/ES-dx fuer Korrekturschritt exportieren
  (setq *gf-L-ohne-as-es* (+ L-gerade (float sum-dx-bogen)))
  (setq *gf-sum-dz-bogen* sum-dz-bogen)
  ;; Gesamter Nenn-Laengenanteil: Gerade + AS/ES-dx + Bogen-dx
  ;; dH_grade = L_total * sin(v); dH_fix = aus-dz + ein-dz + sum-dz-bogen
  (setq L-gerade (+ L-gerade (float aus-dx) (float ein-dx) (float sum-dx-bogen)))
  (setq deltaH-eff (- (float deltaH) (float aus-dz) (float ein-dz) sum-dz-bogen))
  (princ (strcat "\n  Gesamte Nennlaenge (inkl. Bogen-dx): " (rtos L-gerade 2 1) " mm"))
  (princ (strcat "\n  Feste Hoehenanteile (AS/ES-dz + Bogen-dz): "
                 (rtos (+ (float aus-dz) (float ein-dz) sum-dz-bogen) 2 1) " mm"))
  (princ (strcat "\n    aus-dz=" (rtos (float aus-dz) 2 2)
                 "  ein-dz=" (rtos (float ein-dz) 2 2)
                 "  Bogen-dz=" (rtos sum-dz-bogen 2 2)))
  (princ (strcat "\n  Effektive Resthoehe fuer Grade:      " (rtos deltaH-eff 2 1) " mm"))
  (cond
    ((<= L-gerade 0.1)
     (princ "\n  WARNUNG: keine geraden Strecken -> Fallback 3 Grad")
     3.0)
    ((< deltaH-eff 0)
     (princ "\n  WARNUNG: feste Anteile > deltaH -> Fallback 1 Grad")
     1.0)
    (t
     (setq sin-alpha (/ deltaH-eff L-gerade))
     (if (> sin-alpha 1.0) (setq sin-alpha 1.0))
     (setq alpha (* (asin sin-alpha) (/ 180.0 pi)))
     (princ (strcat "\n>>> Naeherungswinkel: " (rtos alpha 2 3) grad-zeichen))
     alpha
    )
  )
)

;; Misst die tatsaechliche Z-Absenkung eines Blocks bei gegebener Eingangsrichtung.
;; Fuegt den Block temporaer an Ursprung ein, liest KS_AUS.Z, loescht den Block.
;; xu-dir: normierter 3D-Einheitsvektor der Eingangsrichtung (inkl. Neigung v)
;; Rueckgabe: Z-Absenkung in mm (positiv = nach unten)
(defun gf-messe-dz-block (blockname xu-dir / testframe frame-aus ent-vor ent-nach dz)
  (setq testframe (make-frame-from-dir '(0 0 0) xu-dir))
  (setq ent-vor (entlast))
  (setq frame-aus (insert-block-ks-to-ks blockname testframe))
  (setq ent-nach (entlast))
  ;; Temporaer eingefuegten INSERT-Block loeschen
  (if (and ent-nach (not (eq ent-nach ent-vor)))
    (entdel ent-nach)
  )
  ;; dz: KS_EIN war bei Z=0, KS_AUS.Z ist der Rueckgabewert
  (setq dz (- 0.0 (caddr (car frame-aus))))
  dz
)

;; Alle Segmente des Linienzugs einfuegen.
;; segmente    : Ergebnis von gf-analysiere-kette
;; grade       : Gefaellewinkel in Grad
;; startframe  : Vollstaendiger Rahmen (P xu yu zu) am Kettenanfang
;; Rueckgabe   : Vollstaendiger Rahmen (P xu yu zu) am Kettenende
(defun gf-linienzug-einfuegen (segmente grade startframe /
                                aktuell-frame i n seg naechstes
                                typ hz laenge bwinkel bseite blockname
                                rad-h rad-v xu-incl endpunkt)
  (setq aktuell-frame startframe)
  (setq n (length segmente))
  (setq i 0)
  (while (< i n)
    (setq seg       (nth i segmente))
    (setq naechstes (if (< (1+ i) n) (nth (1+ i) segmente) nil))
    (setq typ    (car seg))
    (setq hz     (cadr seg))
    (setq laenge (caddr seg))
    (setq bwinkel (nth 3 seg))
    (setq bseite  (nth 4 seg))
    (cond
      ((= typ "Linie")
       (princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
                      ": Staustrecke L=" (rtos laenge 2 1) " mm"
                      "  hz=" (rtos hz 2 1) grad-zeichen
                      "  v=" (rtos grade 2 2) grad-zeichen))
       (setq endpunkt
         (gf-insert-hz-incl-scaled
           "Staustrecke_SP_1000_mm" (car aktuell-frame) laenge hz grade))
       ;; Ausgangsrahmen: geneigte Fahrtrichtung
       (setq rad-h (* (float hz)    (/ pi 180.0)))
       (setq rad-v (* (float grade) (/ pi 180.0)))
       (setq xu-incl (list (* (cos rad-h)(cos rad-v))
                            (* (sin rad-h)(cos rad-v))
                            (- (sin rad-v))))
       (setq aktuell-frame (make-frame-from-dir endpunkt xu-incl))
       ;; Separator am Ende dieser Linie, falls naechstes Segment ein Bogen ist
       (if (and naechstes (= (car naechstes) "Bogen"))
         (progn
           (princ (strcat "\n\n" (itoa (1+ i)) "S/" (itoa n)
                          ": Separator 300mm (vor Bogen)"
                          "  hz=" (rtos hz 2 1) grad-zeichen
                          "  v=" (rtos grade 2 2) grad-zeichen))
           (setq endpunkt
             (gf-insert-hz-with-ks
               "Staustrecke_Separator_SP_300_mm" (car aktuell-frame) hz grade 300 0))
           (setq aktuell-frame (make-frame-from-dir endpunkt xu-incl))
         )
       )
      )
      ((= typ "Bogen")
       (setq blockname (gf-bogen-blockname bwinkel bseite))
       (princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
                      ": " blockname
                      "  hz=" (rtos hz 2 1) grad-zeichen))
       ;; Gefaellebogen: KS_EIN an aktuellem Rahmen ausrichten (volle 3D-Rotation)
       (setq aktuell-frame (insert-block-ks-to-ks blockname aktuell-frame))
      )
    )
    (setq i (1+ i))
  )
  (princ "\n\n=========================================")
  (princ "\n>>> Linienzug-Gefaellestrecke eingefuegt! <<<")
  (princ "\n=========================================")
  aktuell-frame)

;; Listenelement an Position idx durch val ersetzen.
(defun gf-replace-nth (lst idx val / i result)
  (setq result '()  i 0)
  (foreach item lst
    (setq result (append result (list (if (= i idx) val item))))
    (setq i (1+ i))
  )
  result
)

;; Ausgangsrichtung (hz in Grad) nach dem letzten Segment berechnen.
;; Fuer Linie: hz des Segments; fuer Bogen: hz-eingang +/- bwinkel.
(defun gf-exit-hz (segmente / i n seg bseite prev-hz)
  (setq prev-hz 0.0  n (length segmente)  i 0)
  (while (< i n)
    (setq seg (nth i segmente))
    (cond
      ((= (car seg) "Linie")
       (setq prev-hz (cadr seg)))
      ((= (car seg) "Bogen")
       (setq bseite (nth 4 seg))
       (setq prev-hz (+ (cadr seg)
                        (* (if (= bseite "links") 1.0 -1.0)
                           (float (nth 3 seg))))))
    )
    (setq i (1+ i))
  )
  prev-hz
)

;; Hauptfunktion Modus 3
(defun gf-linienzug-modus ( /
                              ss n i j obj obj-liste kette segmente seg
                              startpunkt endpunkt-ref deltaH grade antwort idx
                              as-seite es-seite as-block es-block
                              entry-hz exit-hz
                              first-idx last-idx neu-l
                              aktuell-frame nach-aus-pt
                              gf-nummer last-ent
                              L-gf-str delta-l-gf laengen-liste first-l l-item
                              bL90 bL60 bL30 bR90 bR60 bR30 n-bogen-gf
                              ein-hz-as rad-h-as rad-v-as xu-entry
                              sep-endpunkt rad-h-es rad-v-es xu-exit sep-frame
                              es-aus-frame
                              rad-v-korr ein-hz-as-k rad-h-as-k xu-as-meas
                              rad-h-es-k xu-es-meas dz-as-ist dz-es-ist
                              dH-korr grade-prev iter)
  (princ "\n\n>>> MODUS 3: Linienzug auswaehlen <<<")
  (princ "\nBitte alle Linien (LINE) und Boegen (ARC) des Pfades auswaehlen,")
  (princ "\ndann ENTER druecken:")

  ;; Selektion
  (setq ss (ssget (list (cons 0 "LINE,ARC"))))
  (if (null ss)
    (progn (princ "\nKeine Objekte ausgewaehlt!") (exit))
  )
  (setq n (sslength ss))
  (princ (strcat "\n  " (itoa n) " Objekte ausgewaehlt."))

  ;; Objekte in Liste
  (setq obj-liste '()  i 0)
  (while (< i n)
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (setq obj-liste (append obj-liste (list obj)))
    (setq i (1+ i))
  )

  ;; Startpunkt: Kettenanfang (Sortierung) + KS_EIN-Position des AUS-Elements
  ;; Z-Hoehe = Anschlusshoehe der Gesamtstrecke (deltaH-Referenz oben)
  (setq startpunkt
    (getpoint "\nStartpunkt (3D) waehlen - KS_EIN AUS-Element / Kettenanfang: "))
  (if (null startpunkt)
    (progn (princ "\nKein Startpunkt!") (exit))
  )

  ;; Endpunkt: KS_AUS-Position des EIN-Elements (Z-Referenz unten)
  ;; deltaH = |startpunkt.Z - endpunkt-ref.Z|
  (setq endpunkt-ref
    (getpoint "\nEndpunkt (3D) waehlen - KS_AUS EIN-Element / Kettenende: "))
  (if (null endpunkt-ref)
    (progn (princ "\nKein Endpunkt!") (exit))
  )

  ;; DeltaH aus Z-Koordinaten
  (setq deltaH (abs (- (caddr startpunkt) (caddr endpunkt-ref))))
  (princ (strcat "\n  " delta-sym "H aus 3D-Punkten: " (rtos deltaH 2 1) " mm"))

  ;; Kette sortieren
  (princ "\n  Sortiere Segmente ...")
  (setq kette (gf-sortiere-objekte obj-liste startpunkt))
  (if (null kette)
    (progn (alert "Keine verbundene Kette gefunden!") (exit))
  )
  (princ (strcat " " (itoa (length kette)) " Segmente gefunden."))

  ;; Segmente analysieren
  (setq segmente (gf-analysiere-kette kette))

  ;; Eingangs- und Ausgangsrichtung bestimmen
  (setq entry-hz (cadr (car segmente)))
  (setq exit-hz  (gf-exit-hz segmente))

  ;; Seite fuer AUS-Element (vor Winkelberechnung, da Laengenanpassung davon abhaengt)
  (princ "\n\nAUS-Element (AS_Element_90_*) - Seite waehlen:")
  (princ "\n  1 - Links")
  (princ "\n  2 - Rechts")
  (setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
  (setq as-seite (if (= antwort "2") "rechts" "links"))

  ;; Seite fuer EIN-Element
  (princ "\n\nEIN-Element (ES_Element_90_*) - Seite waehlen:")
  (princ "\n  1 - Links")
  (princ "\n  2 - Rechts")
  (setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
  (setq es-seite (if (= antwort "2") "rechts" "links"))

  (setq as-block (strcat "AS_Element_90_" as-seite))
  (setq es-block (strcat "ES_Element_90_" es-seite))

  ;; Segmentlaengen anpassen.
  ;; Die gezeichneten Linien enthalten die Laengen von AUS-/EIN-Element UND Separatoren.
  ;; Abzugsregel pro LINE-Segment:
  ;;   Erstes LINE-Segment:            - aus-dx
  ;;   LINE gefolgt von BOGEN:         - 300 mm (Separator vor Bogen)
  ;;   Letztes LINE-Segment:           - 300 mm (Separator vor EIN) - ein-dx
  (setq first-idx -1  j 0)
  (while (and (< j (length segmente)) (< first-idx 0))
    (if (= (car (nth j segmente)) "Linie") (setq first-idx j))
    (setq j (1+ j))
  )
  (setq last-idx -1  j (1- (length segmente)))
  (while (and (>= j 0) (< last-idx 0))
    (if (= (car (nth j segmente)) "Linie") (setq last-idx j))
    (setq j (1- j))
  )
  (if (>= first-idx 0)
    (progn
      (setq i 0)
      (while (< i (length segmente))
        (setq seg (nth i segmente))
        (if (= (car seg) "Linie")
          (progn
            (setq neu-l (caddr seg))
            ;; Erstes LINE-Segment: AUS-Element abziehen
            (if (= i first-idx) (setq neu-l (- neu-l aus-dx)))
            ;; Naechstes Segment ist BOGEN: Separator (300 mm) abziehen
            (if (and (< (1+ i) (length segmente))
                     (= (car (nth (1+ i) segmente)) "Bogen"))
              (setq neu-l (- neu-l 300.0))
            )
            ;; Letztes LINE-Segment: Separator vor EIN (300 mm) + EIN-Element abziehen
            (if (= i last-idx) (setq neu-l (- neu-l 300.0 ein-dx)))
            (setq neu-l (max 100.0 neu-l))
            (setq segmente (gf-replace-nth segmente i
                             (list (car seg) (cadr seg) neu-l (nth 3 seg) (nth 4 seg))))
          )
        )
        (setq i (1+ i))
      )
    )
  )

  ;; Segmente nach Laengenanpassung anzeigen
  (princ "\n\n--- Segment-Analyse (Laengen nach Kuerzung) ---")
  (setq idx 0)
  (foreach seg segmente
    (setq idx (1+ idx))
    (if (= (car seg) "Linie")
      (princ (strcat "\n  " (itoa idx) ". Linie   L=" (rtos (caddr seg) 2 1)
                     " mm  hz=" (rtos (cadr seg) 2 1) grad-zeichen))
      (princ (strcat "\n  " (itoa idx) ". Bogen   " (itoa (nth 3 seg))
                     grad-zeichen " " (nth 4 seg)
                     "  hz-Eingang=" (rtos (cadr seg) 2 1) grad-zeichen))
    )
  )
  (princ (strcat "\n  Seg " (itoa (1+ first-idx)) " (1. Linie): -" (rtos aus-dx 2 1) " mm (AUS-Element)"))
  (princ "\n  Jede Linie vor Bogen: -300 mm (Bogen-Separator)")
  (princ (strcat "\n  Seg " (itoa (1+ last-idx)) " (letzte Linie): -300 mm (EIN-Sep) -" (rtos ein-dx 2 1) " mm (EIN-Element)"))
  (princ (strcat "\n  Eintrittsrichtung: " (rtos entry-hz 2 1) grad-zeichen))
  (princ (strcat "\n  Austrittsrichtung: " (rtos exit-hz  2 1) grad-zeichen))

  ;; Gefaellewinkel berechnen (1 Extra-Separator vor EIN-Element)
  (princ "\n\n  Berechne Gefaellewinkel aus Geometrie ...")
  (setq grade (gf-winkel-berechnen segmente deltaH 1))

  ;; Manuelle Anpassung
  (setq antwort
    (getstring (strcat "\nBerechneten Winkel "
                       (rtos grade 2 3) grad-zeichen
                       " verwenden? (j/n) [j]: ")))
  (if (= (strcase antwort) "N")
    (progn
      (setq grade (getreal "\nGefaellewinkel (Grad): "))
      (if (or (null grade) (<= grade 0)) (setq grade 3.0))
    )
  )
  (setq grade (float grade))

  ;; Winkelkorrektur: iterative Messung der tatsaechlichen AS/ES-Absenkung.
  ;; Jede Iteration misst dz_AS und dz_ES beim aktuellen Winkel und berechnet
  ;; einen neuen Winkel. Konvergiert in 2-3 Schritten auf < 0.001 Grad.
  ;; Garantiert: dz_AS(v) + L_stau*sin(v) + dz_ES(v) + dz_bogen = deltaH
  (if (and *gf-L-ohne-as-es* (> *gf-L-ohne-as-es* 0.1))
    (progn
      (princ "\n  Messe tatsaechliche AS/ES-Absenkung (iterativ) ...")
      (setq grade-prev -999.0  iter 0)
      (while (and (< iter 4) (> (abs (- grade grade-prev)) 0.001))
        (setq grade-prev grade)
        (setq rad-v-korr (* grade (/ pi 180.0)))
        ;; AS-Element: KS_EIN zeigt 90 Grad zur Fahrtrichtung
        (setq ein-hz-as-k (if (= as-seite "rechts") (+ entry-hz 90.0) (- entry-hz 90.0)))
        (setq rad-h-as-k  (* (float ein-hz-as-k) (/ pi 180.0)))
        (setq xu-as-meas (list (* (cos rad-h-as-k)(cos rad-v-korr))
                               (* (sin rad-h-as-k)(cos rad-v-korr))
                               (- (sin rad-v-korr))))
        ;; ES-Element: KS_EIN zeigt in Fahrtrichtung (exit-hz)
        (setq rad-h-es-k (* (float exit-hz) (/ pi 180.0)))
        (setq xu-es-meas (list (* (cos rad-h-es-k)(cos rad-v-korr))
                               (* (sin rad-h-es-k)(cos rad-v-korr))
                               (- (sin rad-v-korr))))
        (setq dz-as-ist (gf-messe-dz-block as-block xu-as-meas))
        (setq dz-es-ist (gf-messe-dz-block es-block xu-es-meas))
        ;; sin(v) = (dH - dz_as - dz_es - dz_bogen) / L_stau
        (setq dH-korr (- (float deltaH) dz-as-ist dz-es-ist (float *gf-sum-dz-bogen*)))
        (if (and (> dH-korr 0.0) (< (/ dH-korr *gf-L-ohne-as-es*) 1.0))
          (setq grade (* (asin (/ dH-korr *gf-L-ohne-as-es*)) (/ 180.0 pi)))
          (progn
            (princ "\n  WARNUNG: Korrektur ausserhalb Bereich, Winkel unveraendert")
            (setq grade-prev grade)
          )
        )
        (setq iter (1+ iter))
      )
      (princ (strcat "\n    AS: " (rtos dz-as-ist 2 2) " mm"
                     "  ES: " (rtos dz-es-ist 2 2) " mm"))
      (princ (strcat "\n>>> Korrigierter Gefaellewinkel: " (rtos grade 2 3) grad-zeichen
                     " (nach " (itoa iter) " Iter.)"))
    )
  )

  ;; Horizontaldistanz Start->Ende fuer Zusammenfassung und Label
  (setq delta-l-gf
    (sqrt (+ (expt (- (car  endpunkt-ref) (car  startpunkt)) 2)
             (expt (- (cadr endpunkt-ref) (cadr startpunkt)) 2))))

  ;; Zusammenfassung
  (princ "\n\n=========================================")
  (princ (strcat "\n>>> Segmente:         " (itoa (length segmente))))
  (princ (strcat "\n>>> " delta-sym "H:             " (rtos deltaH 2 2) " mm"))
  (princ (strcat "\n>>> " delta-sym "L:             " (rtos delta-l-gf 2 1) " mm"))
  (princ (strcat "\n>>> Gefaellewinkel:   " (rtos grade 2 3) grad-zeichen))
  (princ (strcat "\n>>> Eintrittswinkel:  " (rtos entry-hz 2 1) grad-zeichen))
  (princ (strcat "\n>>> Austrittswinkel:  " (rtos exit-hz  2 1) grad-zeichen))
  (princ (strcat "\n>>> AUS-Element:      " as-block))
  (princ (strcat "\n>>> EIN-Element:      " es-block))
  (princ "\n=========================================")

  ;; Bestaetigung
  (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
  (if (not (= antwort "2"))
    (progn
      ;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern.
      ;; vf-lastent-ohne-attribute ueberspringt Attribut-Entities/SEQEND
      ;; eines vorherigen GF_N/VF_N-Blocks, sonst rutschen sie in die
      ;; naechste Blockerstellung hinein.
      (setq gf-nummer (gf-next-number))
      (setq last-ent  (vf-lastent-ohne-attribute))

      ;; AUS-Element: KS_EIN so ausrichten, dass KS_AUS in Fahrtrichtung entry-hz zeigt.
      ;; Beweis: KS_AUS.xu = -yu(target-frame). Fuer KS_AUS||entry-hz gilt:
      ;;   rechts (Rechtskurve): KS_EIN = entry-hz + 90deg
      ;;   links  (Linkskurve):  KS_EIN = entry-hz - 90deg
      (setq ein-hz-as (if (= as-seite "rechts")
                        (+ entry-hz 90.0)
                        (- entry-hz 90.0)))
      (setq rad-h-as (* (float ein-hz-as) (/ pi 180.0)))
      (setq rad-v-as (* (float grade)     (/ pi 180.0)))
      (setq xu-entry (list (* (cos rad-h-as)(cos rad-v-as))
                           (* (sin rad-h-as)(cos rad-v-as))
                           (- (sin rad-v-as))))
      (princ (strcat "\n\n>>> AUS-Element: " as-block
                     "  Fahrtrichtung=" (rtos entry-hz 2 1) grad-zeichen
                     "  KS_EIN-hz=" (rtos ein-hz-as 2 1) grad-zeichen
                     "  Z=" (rtos (caddr startpunkt) 2 1)))
      ;; Block-Ursprung (nicht KS_EIN!) in X/Y auf startpunkt setzen, damit die
      ;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den
      ;; ausgewaehlten Startpunkt verlaeuft. KS_EIN sitzt seitlich versetzt
      ;; (Drehteller-Anschluss) und darf daher nicht direkt auf startpunkt liegen.
      ;; Die Z-Hoehe wird weiterhin an KS_EIN gemessen (konsistent mit Modus 1+2
      ;; und der Gefaellewinkel-Korrektur), damit KS_EIN.Z = startpunkt.Z gilt.
      (setq aktuell-frame
        (insert-block-mixed-to-ks as-block (make-frame-from-dir startpunkt xu-entry)
                                   (caddr startpunkt) nil "KS_EIN"))
      (setq nach-aus-pt (car aktuell-frame))

      ;; Linienzug mit Gefaellebogen und Separatoren (Frame-basiert)
      (setq aktuell-frame (gf-linienzug-einfuegen segmente grade aktuell-frame))

      ;; Separator vor EIN-Element
      (princ "\n>>> Separator vor EIN-Element")
      (setq sep-endpunkt
        (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
                               (car aktuell-frame) exit-hz grade 300 0))
      ;; Ausgangsrahmen nach Separator fuer ES-Element
      (setq rad-h-es (* (float exit-hz) (/ pi 180.0)))
      (setq rad-v-es (* (float grade)   (/ pi 180.0)))
      (setq xu-exit  (list (* (cos rad-h-es)(cos rad-v-es))
                           (* (sin rad-h-es)(cos rad-v-es))
                           (- (sin rad-v-es))))
      (setq sep-frame (make-frame-from-dir sep-endpunkt xu-exit))

      ;; EIN-Element: KS_EIN bleibt in X/Y auf dem Ketten-Pfad (sep-frame),
      ;; seine eigene Achse verlaeuft damit trivial durch diesen Punkt.
      ;; Die Z-Hoehe wird jedoch an KS_AUS gemessen, damit KS_AUS.Z exakt
      ;; auf endpunkt-ref.Z landet (garantiert die gewuenschte DeltaH).
      (princ (strcat "\n>>> EIN-Element: " es-block
                     "  Ziel-Z=" (rtos (caddr endpunkt-ref) 2 1)))
      (setq es-aus-frame
        (insert-block-mixed-to-ks es-block sep-frame
                                   (caddr endpunkt-ref) "KS_EIN" "KS_AUS"))
      (princ (strcat "\n  Z-Hoehe KS_AUS: " (rtos (caddr (car es-aus-frame)) 2 1) " mm"))

      ;; --- GF_N-Block erstellen ---

      ;; L_GF_m: kommagetrennte Segment-Laengen in Metern (angepasste Staustrecke)
      (setq laengen-liste '()  first-l t)
      (foreach seg segmente
        (if (= (car seg) "Linie")
          (setq laengen-liste
            (append laengen-liste
                    (list (rtos (/ (caddr seg) 1000.0) 2 3))))
        )
      )
      (setq L-gf-str "")
      (foreach l-item laengen-liste
        (if first-l
          (progn (setq L-gf-str l-item) (setq first-l nil))
          (setq L-gf-str (strcat L-gf-str "," l-item))
        )
      )

      ;; Bogen-Typen zaehlen
      (setq bL90 0  bL60 0  bL30 0  bR90 0  bR60 0  bR30 0)
      (foreach seg segmente
        (if (= (car seg) "Bogen")
          (progn
            (cond
              ((and (= (nth 4 seg) "links")  (= (nth 3 seg) 90)) (setq bL90 (1+ bL90)))
              ((and (= (nth 4 seg) "links")  (= (nth 3 seg) 60)) (setq bL60 (1+ bL60)))
              ((and (= (nth 4 seg) "links")  (= (nth 3 seg) 30)) (setq bL30 (1+ bL30)))
              ((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 90)) (setq bR90 (1+ bR90)))
              ((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 60)) (setq bR60 (1+ bR60)))
              ((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 30)) (setq bR30 (1+ bR30)))
            )
          )
        )
      )
      (setq n-bogen-gf (+ bL90 bL60 bL30 bR90 bR60 bR30))

      ;; delta-l-gf bereits vor der Zusammenfassung berechnet

      ;; Block mit allen Attributen erstellen
      (gf-block-erstellen
        "gruppe" as-seite gf-nummer
        (caddr startpunkt)
        (caddr endpunkt-ref)
        deltaH
        delta-l-gf
        L-gf-str
        grade
        (1+ n-bogen-gf)
        0
        bL90 bL60 bL30
        bR90 bR60 bR30
        startpunkt last-ent nach-aus-pt entry-hz
        (caddr (nth first-idx segmente))
        es-seite)

      (princ "\n\n=========================================")
      (princ "\n>>> Fertig! <<<")
      (princ "\n=========================================")
    )
    (princ "\nAbgebrochen.")
  )
)

;; ============================================================
;; TEIL 4.5: GF-BLOCK-SYSTEM (Nummerierung, Label, Attribute)
;; ============================================================

;; Attribut-Definitionen fuer GF_N-Bloecke kommen aus dem gemeinsamen
;; Strecken-Schema in ssg_core.lsp (ssg-strecke-attrib-defs). TYP wird zur
;; Laufzeit bestimmt: ohne Bogen -> "Gefaellestrecke" (reduziert), mit Bogen
;; -> "Streckengruppe" (voll).

;; Naechste freie GF-Nummer
;; Stufe 1: NUMMER-Attribut aller GF_*-Inserts lesen
;; Stufe 2: Block-Tabelle pruefen – GF_N darf noch nicht als Definition existieren
(defun gf-next-number ( / ss i nr maxnr bname)
  (setq maxnr 0)
  (setq ss (ssget "X" '((0 . "INSERT") (2 . "GF_*"))))
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        ;; Nummer aus dem Blocknamen GF_<n> ableiten ("GF_" = 3 Zeichen)
        (setq bname (cdr (assoc 2 (entget (ssname ss i)))))
        (setq nr (atoi (substr bname 4)))
        (if (> nr maxnr) (setq maxnr nr))
        (setq i (1+ i))
      )
    )
  )
  (setq #GF_LetzteNr (max #GF_LetzteNr maxnr))
  (setq #GF_LetzteNr (1+ #GF_LetzteNr))
  ;; Sicherstellen, dass GF_N noch nicht als Block-Definition existiert
  (while (tblsearch "BLOCK" (strcat "GF_" (itoa #GF_LetzteNr)))
    (princ (strcat "\n  [GF-Nr] GF_" (itoa #GF_LetzteNr) " existiert bereits, naechste..."))
    (setq #GF_LetzteNr (1+ #GF_LetzteNr))
  )
  #GF_LetzteNr
)

;; Sichtbare Beschriftung auf Layer GF_Beschriftung erzeugen.
;; nach-aus-pt:  KS_AUS des AUS-Elements (Beginn der ersten Geraden).
;; entry-hz:     Horizontalwinkel der Foerderrichtung in Grad.
;; L-first-seg:  Laenge der ersten geraden Staustrecke in mm.
;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht rechts versetzt.
(defun gf-make-label (gf-nummer hoehe-von hoehe-bis deltaH deltaL
                      L-gf-str winkel n-separator nach-aus-pt entry-hz L-first-seg /
                      label-txt label-pt chz-l shz-l halb basis-winkel)
  (setq chz-l (cos (* entry-hz (/ pi 180.0))))
  (setq shz-l (sin (* entry-hz (/ pi 180.0))))
  (setq halb  (/ (float L-first-seg) 2.0))
  (setq label-pt
    (list (+ (car  nach-aus-pt) (* halb chz-l) (*  400.0 shz-l))
          (+ (cadr nach-aus-pt) (* halb shz-l) (* -400.0 chz-l))
          (caddr nach-aus-pt)))
  (setq label-txt
    (strcat "GF" (itoa gf-nummer)
            "  von:" (itoa (fix hoehe-von)) " bis:" (itoa (fix hoehe-bis)) "mm"
            "  " delta-sym "H=" (itoa (fix (abs deltaH))) "mm"
            "  " delta-sym "L=" (itoa (fix deltaL)) "mm"
            "  L=[" L-gf-str "]m"
            "  W=" (rtos (float winkel) 2 2) grad-zeichen
            "  Sep=" (itoa n-separator)))
  ;; Basiswinkel: Text immer lesbar auf 0 Grad (X-Achse, links->rechts) oder
  ;; 90 Grad (Y-Achse) einrasten - unabhaengig von der tatsaechlichen
  ;; Fahrtrichtung (nie 180/270, damit der Text nie auf dem Kopf steht).
  (setq basis-winkel (float entry-hz))
  (while (< basis-winkel 0.0)    (setq basis-winkel (+ basis-winkel 360.0)))
  (while (>= basis-winkel 360.0) (setq basis-winkel (- basis-winkel 360.0)))
  (if (>= basis-winkel 180.0) (setq basis-winkel (- basis-winkel 180.0)))
  (setq basis-winkel (if (or (< basis-winkel 45.0) (>= basis-winkel 135.0)) 0.0 90.0))
  (entmake
    (list '(0 . "TEXT")
          (cons 10 label-pt)
          (cons 11 label-pt)
          '(40 . 100.0)
          (cons 1 label-txt)
          '(7 . "Standard")
          '(8 . "GF_Beschriftung")
          (cons 50 (* basis-winkel (/ pi 180.0)))
          '(72 . 1)
          '(73 . 2)))
)

;; GF_N-Block aus allen seit last-ent erzeugten Entities erstellen
;; und alle 18 Attribute setzen.
(defun gf-block-erstellen (typ seite gf-nummer
                            hoehe-von hoehe-bis deltaH deltaL
                            L-gf-str winkel n-separator n-scanner
                            bogen-L90 bogen-L60 bogen-L30
                            bogen-R90 bogen-R60 bogen-R30
                            startpunkt last-ent nach-aus-pt entry-hz L-first-seg
                            es-seite /
                            gf-bname gf-ss ent gf-insert typ-str anzahl-gf
                            gf-winkel-str i)
  ;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht versetzt
  (gf-make-label gf-nummer hoehe-von hoehe-bis deltaH deltaL
                 L-gf-str winkel n-separator nach-aus-pt entry-hz L-first-seg)
  ;; TYP: mit Bogen -> "Streckengruppe"; ohne Bogen (einsegmentig) ->
  ;; "Gefaellestrecke" (reduzierter Attributsatz, siehe ssg-strecke-attrib-defs).
  (setq typ-str
    (if (> (+ bogen-L90 bogen-L60 bogen-L30 bogen-R90 bogen-R60 bogen-R30) 0)
      "Streckengruppe" "Gefaellestrecke"))
  (setq gf-bname (strcat "GF_" (itoa gf-nummer)))
  ;; Anzahl GF-Segmente = Anzahl kommagetrennter Werte in L-gf-str;
  ;; GF_WINKEL parallel dazu (alle Segmente teilen die Gefaelle-Neigung).
  (setq anzahl-gf 1  i 1)
  (while (<= i (strlen L-gf-str))
    (if (= (substr L-gf-str i 1) ",") (setq anzahl-gf (1+ anzahl-gf)))
    (setq i (1+ i)))
  (setq gf-winkel-str (rtos (float winkel) 2 1)  i 1)
  (while (< i anzahl-gf)
    (setq gf-winkel-str (strcat gf-winkel-str "," (rtos (float winkel) 2 1)))
    (setq i (1+ i)))
  ;; ATTDEFs (unsichtbar, am Startpunkt) nach gemeinsamem Strecken-Schema
  (foreach def (ssg-strecke-attrib-defs typ-str)
    (entmake
      (list '(0 . "ATTDEF")
            (cons 10 startpunkt)
            (cons 11 startpunkt)
            '(40 . 50.0)
            (cons 1 (cadr def))
            (cons 2 (car def))
            (cons 3 (car def))
            '(70 . 1)
            '(72 . 0)
            '(74 . 0)))
  )
  ;; Alle Entities seit last-ent in Selektionssatz sammeln
  (setq gf-ss (ssadd))
  (setq ent (if last-ent (entnext last-ent) (entnext)))
  (while ent
    (ssadd ent gf-ss)
    (setq ent (entnext ent))
  )
  ;; Block definieren und einfuegen (ATTREQ/ATTDIA=0: keine interaktive Abfrage)
  (setvar "ATTREQ" 0)
  (setvar "ATTDIA" 0)
  (command "_.-BLOCK" gf-bname startpunkt gf-ss "")
  (command "_.INSERT" gf-bname startpunkt 1.0 1.0 0.0)
  (setvar "ATTREQ" 1)
  ;; Attribute auf das eingefuegte INSERT-Objekt setzen (volle Werteliste;
  ;; nicht vorhandene Tags ignoriert ssg-attrib-set-on -> reduzierter Satz ok).
  (setq gf-insert (entlast))
  (ssg-attrib-set-on gf-insert
    (list
      (cons "Bezeichnung"      gf-bname)
      (cons "MONTAGEHOEHE_m"   "0.000")
      (cons "HOEHE_VON_mm"     (itoa (fix hoehe-von)))
      (cons "HOEHE_BIS_mm"     (itoa (fix hoehe-bis)))
      (cons "DELTA_H_mm"       (itoa (fix (abs deltaH))))
      (cons "DELTA_L_mm"       (itoa (fix deltaL)))
      (cons "TYP"              typ-str)
      (cons "SEITE_AS"         seite)
      (cons "SEITE_ES"         es-seite)
      (cons "ANZAHL_GF"        (itoa anzahl-gf))
      (cons "L_GF_m"           L-gf-str)
      (cons "GF_WINKEL"        gf-winkel-str)
      (cons "GF_Bogen_L_90"    (itoa bogen-L90))
      (cons "GF_Bogen_L_60"    (itoa bogen-L60))
      (cons "GF_Bogen_L_30"    (itoa bogen-L30))
      (cons "GF_Bogen_R_90"    (itoa bogen-R90))
      (cons "GF_Bogen_R_60"    (itoa bogen-R60))
      (cons "GF_Bogen_R_30"    (itoa bogen-R30))
      (cons "ANZAHL_SEPARATOR" (itoa n-separator))
      (cons "ANZAHL_SCANNER"   (itoa n-scanner))
    )
  )
  ;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
  (if (car (atoms-family 1 '("SSG-ID-GENERATE")))
    (ssg-id-generate gf-insert))
  (princ (strcat "\n>>> GF-Block erstellt: " gf-bname " (" typ-str ")"))
  gf-insert
)

;; ============================================================
;; TEIL 5: MODUS 1+2 - EINFACHE GEFAELLESTRECKE
;; ============================================================

;; deltaL-total: gesamte Horizontaldistanz (fuer DELTA_L-Attribut)
;; hz: Fahrtrichtung in Grad (0=Ost, 90=Nord, 180=West, 270=Sued)
(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt as-seite es-seite hz deltaL-total /
                                   as-block es-block endpunkt
                                   gf-nummer last-ent rad-hz rad-v xu-incl
                                   ein-hz rad-ein xu-ein
                                   startframe aktuell-frame
                                   stau-endpunkt sep-endpunkt sep-frame
                                   gf-deltaH L-gf-str nach-aus-pt gf-insert)
  (setq as-block (strcat "AS_Element_90_" as-seite))
  (setq es-block (strcat "ES_Element_90_" es-seite))
  (if (not *lib-initialized*) (gf-init-bibliothek))

  ;; GF-Nummer und Entity-Grenze vor erster Einfuegung
  (setq gf-nummer (gf-next-number))
  (setq last-ent  (vf-lastent-ohne-attribute))

  ;; Fahrtrichtungsvektor (KS_AUS-Richtung, Basis fuer Staustrecke/Separator/ES)
  (setq rad-hz (* (float hz)     (/ pi 180.0)))
  (setq rad-v  (* (float winkel) (/ pi 180.0)))
  (setq xu-incl (list (* (cos rad-hz)(cos rad-v))
                      (* (sin rad-hz)(cos rad-v))
                      (- (sin rad-v))))

  ;; KS_EIN-Richtung fuer AS-Element: so dass KS_AUS in Fahrtrichtung hz zeigt.
  ;; Beweis: KS_AUS.xu = -yu (target-frame), yu = links-senkrecht zu xu.
  ;;   rechts (Rechtskurve): KS_AUS = KS_EIN - 90deg  =>  KS_EIN = hz + 90deg
  ;;   links  (Linkskurve):  KS_AUS = KS_EIN + 90deg  =>  KS_EIN = hz - 90deg
  (setq ein-hz (if (= as-seite "rechts") (+ hz 90.0) (- hz 90.0)))
  (setq rad-ein (* (float ein-hz) (/ pi 180.0)))
  (setq xu-ein (list (* (cos rad-ein)(cos rad-v))
                     (* (sin rad-ein)(cos rad-v))
                     (- (sin rad-v))))

  ;; 1/4: AUS-Element (KS_EIN an xu-ein ausrichten, damit KS_AUS in hz zeigt)
  ;; Block-Ursprung (nicht KS_EIN!) in X/Y auf startpunkt setzen, damit die
  ;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den
  ;; ausgewaehlten Startpunkt verlaeuft (analog Modus 3). Die Z-Hoehe wird
  ;; weiterhin an KS_EIN gemessen, damit KS_EIN.Z = startpunkt.Z gilt.
  (princ (strcat "\n\n1/4: " as-block
                 "  Fahrtrichtung=" (rtos hz 2 1) grad-zeichen
                 "  KS_EIN-hz=" (rtos ein-hz 2 1) grad-zeichen
                 "  v=" (rtos winkel 2 1) grad-zeichen))
  (setq startframe (make-frame-from-dir startpunkt xu-ein))
  (setq aktuell-frame
    (insert-block-mixed-to-ks as-block startframe (caddr startpunkt) nil "KS_EIN"))
  (setq nach-aus-pt (car aktuell-frame))

  ;; 2/4: Staustrecke (skalierbar, hz+vert)
  (princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1)
                 " mm  hz=" (rtos hz 2 1) grad-zeichen
                 "  v=" (rtos winkel 2 1) grad-zeichen))
  (setq stau-endpunkt
    (gf-insert-hz-incl-scaled
      "Staustrecke_SP_1000_mm" (car aktuell-frame) L_stau hz winkel))
  (setq aktuell-frame (make-frame-from-dir stau-endpunkt xu-incl))

  ;; 3/4: Separator 300mm
  (princ (strcat "\n\n3/4: Separator 300mm"
                 "  hz=" (rtos hz 2 1) grad-zeichen
                 "  v=" (rtos winkel 2 1) grad-zeichen))
  (setq sep-endpunkt
    (gf-insert-hz-with-ks
      "Staustrecke_Separator_SP_300_mm" (car aktuell-frame) hz winkel 300 0))
  (setq sep-frame (make-frame-from-dir sep-endpunkt xu-incl))

  ;; 4/4: EIN-Element (KS-zu-KS)
  (princ (strcat "\n\n4/4: " es-block))
  (setq endpunkt (car (insert-block-ks-to-ks es-block sep-frame)))

  ;; Abgeleitete Werte: echte Endhoehe aus tatsaechlicher Ketten-Platzierung
  ;; (AS_Element + Staustrecke + Separator + ES_Element zusammen)
  (setq gf-deltaH (- (caddr startpunkt) (caddr endpunkt)))
  (setq L-gf-str  (rtos (/ L_stau 1000.0) 2 3))

  ;; GF_N-Block mit Attributen erstellen; Rueckgabe: ename des GF_N-INSERT
  (setq gf-insert
    (gf-block-erstellen
      "standard" as-seite gf-nummer
      (caddr startpunkt)
      (caddr endpunkt)
      gf-deltaH
      (float deltaL-total)
      L-gf-str
      winkel
      1 0
      0 0 0  0 0 0
      startpunkt last-ent nach-aus-pt (float hz) (float L_stau)
      es-seite))

  (princ "\n\n=========================================")
  (princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<")
  (princ "\n=========================================")
  ;; Rueckgabe: (ename echtes-deltaH echtes-deltaL) - volle Fliesskomma-
  ;; Genauigkeit, unabhaengig von der auf ganze mm gerundeten HOEHE_VON/
  ;; HOEHE_BIS-Attribut-Darstellung im GF_N-Block.
  (list gf-insert gf-deltaH (float deltaL-total))
)

;; ============================================================
;; TEIL 6: HAUPTBEFEHL
;; ============================================================

(defun c:GEFAELLESTRECKE ( / antwort eingabe-modus deltaL winkel rad L_stau sep-x
                             as-seite es-seite
                             line-points startpunkt endpunkt differenz
                             deltaX deltaY startpunkt-fuer-einfuegen hz-winkel)

  (princ "\n=========================================")
  (princ "\n     GEFAELLESTRECKE GENERATOR v2.0")
  (princ "\n     Richtung: immer AB (nach unten)")
  (princ "\n=========================================")

  ;; Bibliothek initialisieren
  (if (not (gf-init-bibliothek))
    (progn
      (alert "Fehler beim Initialisieren der Bibliothek!\nBitte DXFM_DATA pruefen.")
      (exit)
    )
  )

  ;; Eingabemodus
  (princ "\n\nEingabemodus waehlen:")
  (princ "\n  1 - Werte manuell eingeben (einfache Strecke)")
  (princ "\n  2 - 3D-Linie auswaehlen (einfache Strecke)")
  (princ "\n  3 - Linienzug (LINE + ARC) auswaehlen mit Gefaellebogen")
  (setq antwort (getstring "\nIhre Wahl (1/2/3) [1]: "))

  (cond
    ;; Modus 3: Linienzug mit Bogen
    ((= antwort "3")
     (gf-linienzug-modus)
    )

    ;; Modus 1+2: einfache Gefaellestrecke
    (t
     (if (= antwort "2")
       (setq eingabe-modus "Linie")
       (setq eingabe-modus "Manuell")
     )

     ;; Modus 1: Manuelle Eingabe
     (if (= eingabe-modus "Manuell")
       (progn
         (princ "\n\n>>> MODUS 1: Manuelle Werteingabe <<<")
         (setq startpunkt-fuer-einfuegen
           (getpoint "\nStartpunkt fuer AUS_Element waehlen: "))
         (if (null startpunkt-fuer-einfuegen)
           (setq startpunkt-fuer-einfuegen '(0 0 0)))
         (setq deltaL (getreal (strcat "\n" delta-sym "L - Abstand (mm): ")))
         (if (or (null deltaL) (<= deltaL 0))
           (setq deltaL (ssg-cfg-or "gefaelle" "default_delta_l" 5000.0)))
       )
       ;; Modus 2: 3D-Linie
       (progn
         (princ "\n\n>>> MODUS 2: 3D-Linie auswaehlen <<<")
         (command "BKS" "W")
         (princ "\n  BKS auf Weltkoordinaten gesetzt.")
         (setq line-points
           (get-line-start-end-points
             "\nBitte 3D-Linie fuer Richtung und Laenge auswaehlen:"))
         (if (null line-points)
           (progn (alert "Keine gueltige Linie ausgewaehlt!") (exit))
         )
         (setq startpunkt (car line-points)
               endpunkt   (cadr line-points))
         (setq differenz (punkt-differenz startpunkt endpunkt))
         (setq deltaX (car differenz)
               deltaY (cadr differenz))
         ;; deltaL: horizontale 2D-Projektion entlang Fahrtrichtung
         (setq deltaL (sqrt (+ (* deltaX deltaX) (* deltaY deltaY))))
         ;; hz-Winkel: Fahrtrichtung aus Linienpunkten (in Grad, 0=Ost)
         (setq hz-winkel (* (angle '(0.0 0.0) (list deltaX deltaY)) (/ 180.0 pi)))
         (princ (strcat "\n  Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen
                        "  (aus Linie)"))
         (princ (strcat "\n  " delta-sym "L = " (rtos deltaL 2 2) " mm"))
         ;; Startpunkt separat waehlen (unabhaengig von Linie)
         (setq startpunkt-fuer-einfuegen
           (getpoint "\nStartpunkt fuer AUS-Element waehlen: "))
         (if (null startpunkt-fuer-einfuegen)
           (progn (princ "\nKein Startpunkt!") (exit))
         )
       )
     )

     (princ "\n\n=========================================")
     (princ (strcat "\n  " delta-sym "L = " (rtos deltaL 2 2) " mm"))
     (princ "\n=========================================")

     ;; Winkelabfrage (beide Modi: manuell)
     (setq winkel (getreal "\n\nGefaellewinkel (Grad) [3]: "))
     (if (or (null winkel) (<= winkel 0))
       (setq winkel (ssg-cfg-or "gefaelle" "default_winkel" 3.0)))
     (setq winkel (float winkel))
     (setq rad (* winkel (/ pi 180.0)))
     (princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen))

     ;; Fahrtrichtung waehlen (nur Modus 1; Modus 2 berechnet hz aus Linie)
     (if (= eingabe-modus "Manuell")
       (progn
         (princ "\n\nFahrtrichtung waehlen:")
         (princ "\n  1 - 0°   (X-Achse +, Ost)")
         (princ "\n  2 - 90°  (Y-Achse +, Nord)")
         (princ "\n  3 - 180° (X-Achse -, West)")
         (princ "\n  4 - 270° (Y-Achse -, Sued)")
         (setq antwort (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
         (cond
           ((= antwort "2") (setq hz-winkel  90.0))
           ((= antwort "3") (setq hz-winkel 180.0))
           ((= antwort "4") (setq hz-winkel 270.0))
           (t               (setq hz-winkel   0.0))
         )
         (princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen))
       )
     )

     ;; Seite AUS-Element waehlen
     (princ "\n\nAUS-Element (AS_Element_90_*) - Seite waehlen:")
     (princ "\n  1 - Links")
     (princ "\n  2 - Rechts")
     (setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
     (setq as-seite (if (= antwort "2") "rechts" "links"))

     ;; Seite EIN-Element waehlen
     (princ "\n\nEIN-Element (ES_Element_90_*) - Seite waehlen:")
     (princ "\n  1 - Links")
     (princ "\n  2 - Rechts")
     (setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
     (setq es-seite (if (= antwort "2") "rechts" "links"))

     ;; Laengenberechnung
     ;; deltaL = aus_dx + L_stau*cos(rad) + sep*cos(rad) + ein_dx
     (setq sep-x (* (ssg-cfg-or "gefaelle" "separator_breite" 300.0) (cos rad)))
     (setq L_stau (/ (- deltaL aus-dx ein-dx sep-x) (cos rad)))

     ;; Validierung
     (if (<= L_stau 0.1)
       (progn
         (alert (strcat "Berechnete Staustreckenlaenge ungueltig: "
                        (rtos L_stau 2 2) " mm\n"
                        "Bitte groesseres deltaL oder kleineren Winkel waehlen."))
         (exit)
       )
     )

     ;; Zusammenfassung
     (princ "\n\n=========================================")
     (princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen))
     (princ (strcat "\n>>> Winkel:        " (rtos winkel 2 1) grad-zeichen))
     (princ (strcat "\n>>> AUS-Seite:     " as-seite))
     (princ (strcat "\n>>> EIN-Seite:     " es-seite))
     (princ (strcat "\n>>> L_stau:        " (rtos L_stau 2 2) " mm"))
     (princ "\n=========================================")

     ;; Bestaetigung
     (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
     (if (not (= antwort "2"))
       (gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen as-seite es-seite hz-winkel deltaL)
       (princ "\nAbgebrochen.")
     )
    )
  )
  nil
)

;; ============================================================
;; START
;; ============================================================
(princ "\n>>> GEFAELLESTRECKE v2.0 geladen <<<")
(princ "\n>>> Befehl: Gefaellestrecke")
(princ "\n    Modus 1: Manuelle Eingabe")
(princ "\n    Modus 2: 3D-Linie")
(princ "\n    Modus 3: Linienzug mit Gefaellebogen")
(if block-pfad (princ (strcat "\n    Block-Pfad: " block-pfad)))
(princ "\n=========================================")
(princ)