;; ============================================================
;; 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 *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))
;; 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))

;; DXFM_DIM sicher lesen (type-Guard gegen nicht-String Rueckgabewerte)
(setq *gf-dxfm-dim* (getenv "DXFM_DIM"))
(if (not (= (type *gf-dxfm-dim*) 'STR)) (setq *gf-dxfm-dim* "3D"))
;; Block-Pfad: primaer aus DXFMAKRO + DXFM_DIM, dann *ssg-lisp-pfad*-Heuristik
(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
      (if (and (not (vlax-erased-p sub-obj))
               (= (vla-get-ObjectName sub-obj) "AcDbBlockReference")
               (or (= (vla-get-Name sub-obj) "KS_EIN")
                   (= (vla-get-Name sub-obj) "KS_AUS")))
        (progn
          (setq ks-ref (vla-get-Name sub-obj))
          (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 /
                               block-obj ks-data ks-ein ks-aus offset ausgang)
    (ensure-block-loaded blockname)
    (if (not (tblsearch "BLOCK" blockname))
      (progn
        (princ (strcat "\n  FEHLER: Block '" blockname "' fehlt"))
        (exit)
      )
    )
    (setq block-obj
      (vla-InsertBlock modelspace
        (vlax-3D-point einfuegepunkt)
        blockname 1.0 1.0 1.0 0))
    (setq ks-data (extract-ks-from-block block-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 offset
          (list (- (car einfuegepunkt)   (car (car ks-ein)))
                (- (cadr einfuegepunkt)  (cadr (car ks-ein)))
                (- (caddr einfuegepunkt) (caddr (car ks-ein)))))
        (vla-Move block-obj
          (vlax-3D-point (car ks-ein))
          (vlax-3D-point einfuegepunkt))
        (setq ausgang
          (list (+ (car (car ks-aus))   (car offset))
                (+ (cadr (car ks-aus))  (cadr offset))
                (+ (caddr (car ks-aus)) (caddr offset))))
        (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 /
                                        rad 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 (* (float winkel) (/ 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 (cos rad) 0 (sin rad) 0)
                (list 0 1 0 0)
                (list (- (sin rad)) 0 (cos rad) 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 (cos rad)))
                (cadr startpunkt)
                (+ (caddr startpunkt) (* (- (sin rad)) laenge))))
        (princ (strcat "\n    " blockname " L=" (rtos laenge 2 1)
                       " -> Z=" (rtos (caddr endpunkt) 2 1)))
        endpunkt
      )
    )
  )
)

;; --- Rotierter Block mit manuellem dx/dz (Richtung X) ---
(if (null (car (atoms-family 1 '("INSERT-ROTATED-BLOCK-WITH-KS"))))
  (defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz /
                                        rad block-obj endpunkt)
    (ensure-block-loaded blockname)
    (setq rad (* (float winkel) (/ 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 (cos rad) 0 (sin rad) 0)
            (list 0 1 0 0)
            (list (- (sin rad)) 0 (cos rad) 0)
            (list 0 0 0 1))))
    (vla-Move block-obj
      (vlax-3D-point '(0 0 0))
      (vlax-3D-point startpunkt))
    (list
      (+ (car startpunkt)
         (+ (* block-dx (cos rad)) (* block-dz (sin rad))))
      (cadr startpunkt)
      (+ (caddr startpunkt)
         (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz))))
  )
)

;; --- 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 '("INIT-BIBLIOTHEK"))))
  (defun init-bibliothek ( / temp-obj ks-data ks-ein ks-aus)
    (if *lib-initialized*
      t
      (progn
        ;; AS-Block laden und Masse extrahieren
        (ensure-block-loaded "_3D_AS_90_links")
        (if (tblsearch "BLOCK" "_3D_AS_90_links")
          (progn
            (setq temp-obj
              (vla-InsertBlock modelspace
                (vlax-3D-point '(0 0 0))
                "_3D_AS_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-ks-ein-local* (car ks-ein))
              )
            )
          )
        )
        ;; ES-Block laden und Masse extrahieren
        (ensure-block-loaded "_3D_ES_90_links")
        (if (tblsearch "BLOCK" "_3D_ES_90_links")
          (progn
            (setq temp-obj
              (vla-InsertBlock modelspace
                (vlax-3D-point '(0 0 0))
                "_3D_ES_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-ks-ein-local* (car ks-ein))
              )
            )
          )
        )
        (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) grad-zeichen "_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: deltaH = (L_gerade + (n_bogen+extra_sep)*300) * sin(alpha) + sum(|dz_bogen|)
(defun gf-winkel-berechnen (segmente deltaH extra-sep /
                              L-gerade sum-dz-bogen n-bogen
                              seg bwinkel bseite masse sin-alpha alpha)
  (setq L-gerade 0.0  sum-dz-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-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)))
  (princ (strcat "\n  Gerade + Separatoren: " (rtos L-gerade 2 1) " mm"))
  (princ (strcat "\n  Bogen-dZ gesamt:      " (rtos sum-dz-bogen 2 1) " mm"))
  (princ (strcat "\n  Resthoehe fuer Grade: "
                 (rtos (- (float deltaH) sum-dz-bogen) 2 1) " mm"))
  (cond
    ((<= L-gerade 0.1)
     (princ "\n  WARNUNG: keine geraden Strecken -> Fallback 3 Grad")
     3.0)
    ((< (- (float deltaH) sum-dz-bogen) 0)
     (princ "\n  WARNUNG: Bogen-dZ > deltaH -> Fallback 1 Grad")
     1.0)
    (t
     (setq sin-alpha
       (/ (- (float deltaH) sum-dz-bogen) L-gerade))
     (if (> sin-alpha 1.0) (setq sin-alpha 1.0))
     (setq alpha (* (asin sin-alpha) (/ 180.0 pi)))
     (princ (strcat "\n>>> Berechneter Gefaellewinkel: "
                    (rtos alpha 2 3) grad-zeichen))
     alpha
    )
  )
)

;; Alle Segmente des Linienzugs einfuegen.
;; segmente: Ergebnis von gf-analysiere-kette
;; grade: Gefaellewinkel in Grad
;; startpunkt: 3D-Einfuegepunkt des ersten Blocks
;;
;; Reihenfolge bei Bogen:
;;   ... Staustrecke (Linie) → Separator am Ende der Linie → Gefaellebogen ...
(defun gf-linienzug-einfuegen (segmente grade startpunkt /
                                 aktuell i n seg naechstes
                                 typ hz laenge bwinkel bseite blockname)
  (setq aktuell startpunkt)
  (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 aktuell
         (gf-insert-hz-incl-scaled
           "Staustrecke_SP_1000_mm" aktuell laenge hz grade))
       ;; 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 aktuell
             (gf-insert-hz-with-ks
               "Staustrecke_Separator_SP_300_mm" aktuell hz grade 300 0))
         )
       )
      )
      ((= typ "Bogen")
       (setq blockname (gf-bogen-blockname bwinkel bseite))
       ;; Gefaellebogen (nur Hz-Rotation, Block hat eigene 3D-Geometrie)
       (princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n)
                      ": " blockname
                      "  hz=" (rtos hz 2 1) grad-zeichen))
       (setq aktuell
         (gf-insert-gefaellebogen-by-ks blockname aktuell hz))
      )
    )
    (setq i (1+ i))
  )
  (princ "\n\n=========================================")
  (princ "\n>>> Linienzug-Gefaellestrecke eingefuegt! <<<")
  (princ "\n=========================================")
  aktuell
)

;; 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
                              chz shz as-target
                              aktuell-pt)
  (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: gleichzeitig Kettenanfang (Sortierung) UND Einfuegepunkt AUS-Element
  (setq startpunkt
    (getpoint "\nStartpunkt (3D) waehlen - AUS-Element / Kettenanfang: "))
  (if (null startpunkt)
    (progn (princ "\nKein Startpunkt!") (exit))
  )

  ;; Endpunkt: Z-Koordinate fuer deltaH-Berechnung
  (setq endpunkt-ref
    (getpoint "\nEndpunkt (3D) waehlen - 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  DeltaH 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 (_3D_AS_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 (_3D_ES_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 "_3D_AS_90_" as-seite))
  (setq es-block (strcat "_3D_ES_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))

  ;; Zusammenfassung
  (princ "\n\n=========================================")
  (princ (strcat "\n>>> Segmente:         " (itoa (length segmente))))
  (princ (strcat "\n>>> DeltaH:           " (rtos deltaH 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
      ;; AUS-Element: Block-Ursprung an startpunkt ausrichten.
      ;; KS_EIN liegt im Block seitlich (Delta-Y = Drehteller-Anschluss).
      ;; Damit KS_AUS auf der gezeichneten Linie liegt, muss der Einfuegepunkt
      ;; um Rz(entry-hz) * ks_ein_local gegenueber startpunkt verschoben werden.
      (setq chz (cos (* entry-hz (/ pi 180.0))))
      (setq shz (sin (* entry-hz (/ pi 180.0))))
      (if *aus-ks-ein-local*
        (setq as-target
          (list (+ (car  startpunkt)
                   (- (* chz (car   *aus-ks-ein-local*))
                      (* shz (cadr  *aus-ks-ein-local*))))
                (+ (cadr  startpunkt)
                   (+ (* shz (car   *aus-ks-ein-local*))
                      (* chz (cadr  *aus-ks-ein-local*))))
                (+ (caddr startpunkt)
                   (caddr *aus-ks-ein-local*))))
        (setq as-target startpunkt)
      )
      (princ (strcat "\n\n>>> AUS-Element: " as-block
                     " (hz=" (rtos entry-hz 2 1) grad-zeichen ")"))
      (setq aktuell-pt (gf-insert-gefaellebogen-by-ks as-block as-target entry-hz))

      ;; Linienzug mit Gefaellebogen und Separatoren (gekuerzte Laengen)
      (setq aktuell-pt (gf-linienzug-einfuegen segmente grade aktuell-pt))

      ;; Separator vor EIN-Element
      (princ "\n>>> Separator vor EIN-Element")
      (setq aktuell-pt
        (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm"
                               aktuell-pt exit-hz grade 300 0))

      ;; EIN-Element mit Austrittsrichtung ausrichten (Rz um exit-hz)
      (princ (strcat "\n>>> EIN-Element: " es-block
                     " (hz=" (rtos exit-hz 2 1) grad-zeichen ")"))
      (gf-insert-gefaellebogen-by-ks es-block aktuell-pt exit-hz)

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

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

(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt seite /
                                   aktueller-punkt as-block es-block endpunkt)
  (setq aktueller-punkt startpunkt)
  (setq as-block (strcat "_3D_AS_90_" seite))
  (setq es-block (strcat "_3D_ES_90_" seite))
  (if (not *lib-initialized*) (init-bibliothek))

  (princ (strcat "\n\n1/4: " as-block))
  (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt))

  (princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1)
                 " mm  " (itoa winkel) grad-zeichen))
  (setq aktueller-punkt
    (insert-inclined-scaled-block
      "Staustrecke_SP_1000_mm" aktueller-punkt L_stau winkel))

  (princ (strcat "\n\n3/4: Separator 300mm  " (itoa winkel) grad-zeichen))
  (setq aktueller-punkt
    (insert-rotated-block-with-ks
      "Staustrecke_Separator_SP_300_mm" aktueller-punkt winkel 300 0))

  (princ (strcat "\n\n4/4: " es-block))
  (setq endpunkt (insert-block-by-ks es-block aktueller-punkt))

  (princ "\n\n=========================================")
  (princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<")
  (princ "\n=========================================")
  endpunkt
)

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

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

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

  ;; Bibliothek initialisieren
  (if (not (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 "\nAbstand deltaL (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 die Gefaellestrecke 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 (abs (car differenz))
               deltaY (abs (cadr differenz)))
         (setq deltaL (max deltaX deltaY))
         (princ (strcat "\n  deltaX=" (rtos deltaX 2 2)
                        " mm, deltaY=" (rtos deltaY 2 2) " mm"))
         (princ (strcat "\n  deltaL = " (rtos deltaL 2 2) " mm"))
         (setq startpunkt-fuer-einfuegen startpunkt)
       )
     )

     (princ "\n\n=========================================")
     (princ (strcat "\n  deltaL = " (rtos deltaL 2 2) " mm"))
     (princ "\n=========================================")

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

     ;; Seite waehlen
     (princ "\n\nEin-/Auselement - Seite waehlen:")
     (princ "\n  1 - Links  (_3D_AS_90_links / _3D_ES_90_links)")
     (princ "\n  2 - Rechts (_3D_AS_90_rechts / _3D_ES_90_rechts)")
     (setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
     (if (= antwort "2") (setq seite "rechts") (setq seite "links"))
     (princ (strcat "\n>>> Seite: " seite))

     ;; 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>>> Winkel:   " (rtos winkel 2 1) grad-zeichen))
     (princ (strcat "\n>>> Seite:    " 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 seite)
       (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)