;; ============================================================
;; FÖRDERANLAGE GENERATOR für BricsCAD Pro
;; Version: 25.0 (Komplett bibliotheksbasiert, keine Fallbacks)
;; Befehl: FOERDERANLAGE
;; ============================================================

(vl-load-com)

;; ============================================================
;; TEIL 1: GLOBALE EINSTELLUNGEN
;; ============================================================
(if (getenv "DXFM_BLOCKS")
  (setq modul-pfad (strcat (getenv "DXFM_BLOCKS") "/"))
  (progn
    (alert "Umgebungsvariable DXFM_BLOCKS nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.")
    (exit)
  )
)

;; Pfad zur Koordinaten-Bibliothek
(if (getenv "DXFM_DATA")
  (setq koordinaten-lib (strcat (getenv "DXFM_DATA") "/block_libraries/ils_library.dwg"))
  (progn
    (alert "Umgebungsvariable DXFM_DATA nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.")
    (exit)
  )
)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq modelspace (vla-get-ModelSpace doc))

;; ============================================================
;; TEIL 2: GLOBALE VARIABLEN (werden aus Bibliothek befüllt)
;; ============================================================
(setq aus-dx nil aus-dy nil aus-dz nil)
(setq ein-dx nil ein-dy nil ein-dz nil)
(setq separator-laenge nil umlenk-laenge nil motorstation-laenge nil)
(setq staustrecke-basis 1000)
(setq FESTE_HORIZONTAL 1600)

;; Bogen-Tabellen (werden aus Bibliothek befüllt)
(setq bogen-auf '())   ;; Format: ((winkel dx dy dz) ...)
(setq bogen-ab '())

;; Cache für geladene Daten
(setq *lib-initialized* nil)
(setq *bogen-cache-loaded* nil)
(setq *modul-cache* nil)
(setq *ks-cache* nil)  ;; KS-Daten Cache: (("blockname" ("KS_EIN" ...) ("KS_AUS" ...)) ...)

;; ============================================================
;; TEIL 3: HILFSFUNKTIONEN
;; ============================================================
(defun vec-length (v)
  (sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v))))
)

(defun ks-line-axis (len)
  (cond
    ((and (> len 0.5) (< len 1.5)) "X")     ;; 1.0
    ((and (> len 99) (< len 101)) "X")      ;; 100.0
    ((and (> len 1.5) (< len 2.5)) "Y")     ;; 2.0
    ((and (> len 2.5) (< len 3.5)) "Z")     ;; 3.0
    (t nil)
  )
)

(defun fmt (x)
  (if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---")
)

(defun punkt-differenz (p1 p2)
  (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1)))
)

;; KS-Daten relativ zu einem Basispunkt machen (fuer Cache)
(defun ks-relativize (ks-data base-pt)
  (mapcar '(lambda (item)
    (list (car item)
          (mapcar '(lambda (pt)
            (list (- (car pt) (car base-pt))
                  (- (cadr pt) (cadr base-pt))
                  (- (caddr pt) (caddr base-pt))))
            (cadr item))))
    ks-data)
)

;; Relative KS-Daten auf einen Basispunkt anwenden
(defun ks-absolutize (ks-rel base-pt)
  (mapcar '(lambda (item)
    (list (car item)
          (mapcar '(lambda (pt)
            (list (+ (car pt) (car base-pt))
                  (+ (cadr pt) (cadr base-pt))
                  (+ (caddr pt) (caddr base-pt))))
            (cadr item))))
    ks-rel)
)

;; ============================================================
;; TEIL 4: KS_EIN/KS_AUS EXTRAKTION (KERN-FUNKTION)
;; ============================================================

;; Grad-Zeichen für Blocknamen
(setq grad-zeichen (chr 176))

;; Extrahiert KS_EIN und KS_AUS aus einem Block (intern, ohne Cache)
;; Rückgabe: (("KS_EIN" (origin x-end y-end z-end))
;;            ("KS_AUS" (origin x-end y-end z-end)))
(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 axis line-len line-vec)
  (dbgf "extract-ks-from-block-raw")
  (dbg block-obj)
  (setq ks-results '())
  
  ;; Block explodieren
  (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))
        
        ;; KS-Block explodieren
        (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))
        )
        
        ;; Ergebnis speichern
        (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))
        )
      )
    )
  )
  
  ;; Aufräumen
  (foreach sub-obj sub-entities
    (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj))
  )

  (dbgreturn ks-results)
)

;; Gecachte Version: prueft *ks-cache* anhand Blockname
;; Beim ersten Aufruf wird explodiert und das Ergebnis relativ
;; zum Einfuegepunkt im Cache gespeichert. Weitere Aufrufe
;; desselben Blocktyps liefern die Daten ohne Explode.
(defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel)
  (dbgf "extract-ks-from-block")
  (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 *ks-cache*))
  (if cached
    (progn
      (dbg (strcat "  KS-Cache HIT: " blockname))
      (dbgreturn (ks-absolutize (cdr cached) insert-pt))
    )
    (progn
      (dbg (strcat "  KS-Cache MISS: " blockname))
      (setq result (extract-ks-from-block-raw block-obj))
      (if result
        (progn
          (setq ks-rel (ks-relativize result insert-pt))
          (setq *ks-cache* (cons (cons blockname ks-rel) *ks-cache*))
        )
      )
      (dbgreturn result)
    )
  )
)

;; ============================================================
;; TEIL 5: PUNKTE-AUSWAHL MIT Z-HÖHE (HIER EINFÜGEN!)
;; ============================================================
(defun get-3d-point-from-object (msg / ent obj pt variant)
  (dbgf "get-3d-point-from-object")
  (princ msg)
  (princ "\n  >> Objekt (Block) wählen: ")
  (setq ent (entsel))
  (if ent
    (progn
      (setq obj (vlax-ename->vla-object (car ent)))

      ;; Versuche Block-Einfügepunkt zu bekommen
      (if (vlax-property-available-p obj 'InsertionPoint)
        (progn
          ;; In BricsCAD: InsertionPoint ist ein VARIANT, kein Safearray!
          (setq variant (vla-get-InsertionPoint obj))
          ;; Variant in Safearray umwandeln
          (setq pt (vlax-safearray->list (vlax-variant-value variant)))
          (princ (strcat "\n  ✓ Block-Einfügepunkt (mit Z):"
                         "\n     X = " (rtos (car pt) 2 3)
                         "\n     Y = " (rtos (cadr pt) 2 3)
                         "\n     Z = " (rtos (caddr pt) 2 3)))
        )
        (progn
          ;; Kein Block: Verwende angeklickten Punkt
          (setq pt (cadr ent))
          (princ (strcat "\n  ✓ Punkt auf Objekt: Z = " (rtos (caddr pt) 2 2) " mm"))
        )
      )
    )
    (progn
      (princ "\n  Kein Objekt gewählt.")
      (setq pt nil)
    )
  )
  (dbgreturn pt)
)

;; ============================================================
;; TEIL 5: 3D-LINIE AUSWÄHLEN (für Start- und Endpunkt mit Höhe)
;; ============================================================
(defun get-line-start-end-points (msg / ent obj start-pt end-pt)
  (princ msg)
  (princ "\n  >> 3D-Linie oder Polylinie wählen (mit Höhendifferenz): ")
  (setq ent (entsel))
  (if ent
    (progn
      (setq obj (vlax-ename->vla-object (car ent)))
      (setq obj-name (vla-get-ObjectName obj))
      
      (cond
        ;; Fall 1: Es ist eine einfache Linie (AcDbLine)
        ((= obj-name "AcDbLine")
         (setq start-pt (vlax-safearray->list 
                         (vlax-variant-value (vla-get-StartPoint obj))))
         (setq end-pt (vlax-safearray->list 
                       (vlax-variant-value (vla-get-EndPoint obj))))
         (princ (strcat "\n  ✓ 3D-Linie erkannt:"
                        "\n     Start: X=" (rtos (car start-pt) 2 2)
                        ", Y=" (rtos (cadr start-pt) 2 2)
                        ", Z=" (rtos (caddr start-pt) 2 2)
                        "\n     Ende:  X=" (rtos (car end-pt) 2 2)
                        ", Y=" (rtos (cadr end-pt) 2 2)
                        ", Z=" (rtos (caddr end-pt) 2 2)))
        )
        
        ;; Fall 2: Es ist eine Polylinie (AcDbPolyline) - kann 3D-Punkte haben
        ((= obj-name "AcDbPolyline")
         (setq start-pt (vlax-curve-getStartPoint obj))
         (setq end-pt (vlax-curve-getEndPoint obj))
         (princ (strcat "\n  ✓ 3D-Polylinie erkannt:"
                        "\n     Start: X=" (rtos (car start-pt) 2 2)
                        ", Y=" (rtos (cadr start-pt) 2 2)
                        ", Z=" (rtos (caddr start-pt) 2 2)
                        "\n     Ende:  X=" (rtos (car end-pt) 2 2)
                        ", Y=" (rtos (cadr end-pt) 2 2)
                        ", Z=" (rtos (caddr end-pt) 2 2)))
        )
        
        ;; Fall 3: Anderer Objekttyp
        (t
         (princ "\n  ✗ FEHLER: Keine Linie oder Polylinie ausgewählt!")
         (setq start-pt nil)
         (setq end-pt nil)
        )
      )
    )
    (progn
      (princ "\n  Kein Objekt gewählt.")
      (setq start-pt nil)
      (setq end-pt nil)
    )
  )
  
  (if (and start-pt end-pt)
    (list start-pt end-pt)
    nil
  )
)
;; ============================================================
;; TEIL 6: BIBLIOTHEK LADEN & MAßE EXTRAHIEREN
;; ============================================================

;; Lädt die Bibliothek und extrahiert ALLE benötigten Maße
(defun init-bibliothek ( / temp-obj bogen-winkel)
  (dbgf "init-bibliothek")

  (if *lib-initialized*
    (progn
      (princ "\n  Bibliothek bereits initialisiert.")
      (dbgreturn t)
    )
    (progn
      (setq *ks-cache* nil)
      (princ "\n  Lade Blockdefinitionen aus Bibliothek...")
      
      (if (findfile koordinaten-lib)
        (progn
          (setq temp-obj (vla-InsertBlock modelspace
                           (vlax-3D-point '(0 0 0))
                           koordinaten-lib
                           1.0 1.0 1.0 0))
          (vla-Delete temp-obj)
          (princ " OK.")
          
          ;; === AUS_ELEMENT Maße extrahieren ===
          (princ "\n  Extrahiere AUS_Element Masse...")
          (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-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 aus-dx (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
                  (setq aus-dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
                  (setq aus-dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
                  (princ (strcat "\n    AUS_Element: dx=" (rtos aus-dx 2 0) ", dz=" (rtos aus-dz 2 0)))
                )
                (princ "\n    FEHLER: KS_EIN/KS_AUS fehlt im AUS_Element!")
              )
            )
            (princ "\n    FEHLER: Block _3D_AS_90_links nicht gefunden!")
          )

          ;; === EIN_ELEMENT Maße extrahieren ===
          (princ "\n  Extrahiere EIN_Element Masse...")
          (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-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 ein-dx (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
                  (setq ein-dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
                  (setq ein-dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
                  (princ (strcat "\n    EIN_Element: dx=" (rtos ein-dx 2 0) ", dz=" (rtos ein-dz 2 0)))
                )
                (princ "\n    FEHLER: KS_EIN/KS_AUS fehlt im EIN_Element!")
              )
            )
            (princ "\n    FEHLER: Block _3D_ES_90_links nicht gefunden!")
          )
          
          ;; === Bogen-Maße extrahieren - ALLE Winkel ===
          (princ "\n  Extrahiere Bogen-Maße...")
          (setq bogen-auf '())
          (setq bogen-ab '())
          
          ;; ALLE verfügbaren Winkel
          (setq bogen-winkel '(3 6 9 12 15 18 21 27 33 39 45 51))
          
          (foreach w bogen-winkel
            ;; Aufwärtsbogen
            (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) grad-zeichen))
            (if (tblsearch "BLOCK" bogen-name)
              (progn
                (setq temp-obj (vla-InsertBlock modelspace
                                  (vlax-3D-point '(0 0 0))
                                  bogen-name 1.0 1.0 1.0 0))
                (setq ks-data (extract-ks-from-block temp-obj))
                (vla-Delete temp-obj)
                
                (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 (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
                    (setq dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
                    (setq dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
                    (setq bogen-auf (cons (list w dx dy dz) bogen-auf))
                    (princ (strcat "\n    ✓ Bogen_auf_" (itoa w) ": dx=" (rtos dx 2 0) " mm, dz=" (rtos dz 2 0) " mm"))
                  )
                  (princ (strcat "\n    ✗ Bogen_auf_" (itoa w) ": KS_EIN/KS_AUS fehlt!"))
                )
              )
              (princ (strcat "\n    ✗ Bogen_auf_" (itoa w) ": Block nicht gefunden!"))
            )
            
            ;; Abwärtsbogen
            (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) grad-zeichen))
            (if (tblsearch "BLOCK" bogen-name)
              (progn
                (setq temp-obj (vla-InsertBlock modelspace
                                  (vlax-3D-point '(0 0 0))
                                  bogen-name 1.0 1.0 1.0 0))
                (setq ks-data (extract-ks-from-block temp-obj))
                (vla-Delete temp-obj)
                
                (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 (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
                    (setq dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
                    (setq dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
                    (setq bogen-ab (cons (list w dx dy dz) bogen-ab))
                    (princ (strcat "\n    ✓ Bogen_ab_" (itoa w) ": dx=" (rtos dx 2 0) " mm, dz=" (rtos dz 2 0) " mm"))
                  )
                  (princ (strcat "\n    ✗ Bogen_ab_" (itoa w) ": KS_EIN/KS_AUS fehlt!"))
                )
              )
              (princ (strcat "\n    ✗ Bogen_ab_" (itoa w) ": Block nicht gefunden!"))
            )
          )
          
          (setq bogen-auf (reverse bogen-auf))
          (setq bogen-ab (reverse bogen-ab))

          (setq *lib-initialized* t)
          (princ "\n  Bibliothek erfolgreich initialisiert.")
          (dbgreturn t)
        )
      )
    )
  )
)

;; Bogen-Maß aus Tabelle holen
(defun get-bogen-mass (tabelle winkel)
  (dbgf "get-bogen-mass")
  (setq result nil)
  (foreach item tabelle
    (if (= (car item) winkel)
      (setq result (cdr item))
    )
  )
  (if (null result)
    (princ (strcat "\n  FEHLER: Winkel " (itoa winkel) " nicht in Bogen-Tabelle!"))
  )
  (dbgreturn result)
)

;; ============================================================
;; TEIL 7: BLOCK EINFÜGEN MIT KS_EIN AUSRICHTUNG
;; ============================================================

;; Block einfügen OHNE Rotation/Skalierung (für AUS/EIN Elemente)
(defun insert-block-by-ks (blockname einfuegepunkt / block-obj ks-data ks-ein ks-aus offset ausgang)
  (if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
    (progn
      (princ (strcat "\n  FEHLER: Ungültiger Einfügepunkt für '" blockname "'"))
      (exit)
    )
  )
  
  (if (not *lib-initialized*) (init-bibliothek))
  
  (princ (strcat "\n  Fuege Block '" blockname "' ein..."))
  
  (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: X=" (rtos (car ausgang) 2 2)
                     ", Z=" (rtos (caddr ausgang) 2 2)))
      ausgang
    )
    (progn
      (princ "\n  WARNUNG: KS_EIN/KS_AUS nicht gefunden!")
      einfuegepunkt
    )
  )
)

;; Skalierte und geneigte Staustrecke einfügen (vereinfacht, ohne KS-Extraktion)
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel / 
                                      rad matrix block-obj endpunkt scale)
  
  (if (<= laenge 0.1)
    (progn
      (princ (strcat "\n  Laenge=" (rtos laenge 2 2) " mm -> uebersprungen"))
      startpunkt
    )
    (progn
      (princ (strcat "\n  Fuege '" blockname "' ein (Laenge=" (rtos laenge 2 2) " mm, Winkel=" (itoa winkel) "°)"))
      
      (setq scale (/ laenge 1000.0))
      (setq rad (* winkel (/ pi 180.0)))
      
      ;; Block direkt am Startpunkt einfügen (nicht erst bei 0,0,0)
      (setq block-obj (vla-InsertBlock modelspace
                        (vlax-3D-point startpunkt)
                        blockname scale 1.0 1.0 0))
      
      ;; Rotation um Y-Achse
      (setq matrix (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-TransformBy block-obj (vlax-tmatrix matrix))
      
      ;; Endpunkt berechnen (für die Verkettung)
      (setq endpunkt (list (+ (car startpunkt) (* laenge (cos rad)))
                          (cadr startpunkt)
                          (+ (caddr startpunkt) (* (- (sin rad)) laenge))))
      
      (princ (strcat "\n    Endpunkt: Z=" (rtos (caddr endpunkt) 2 2)))
      endpunkt
    )
  )
)

;; Fixen Block mit Rotation einfügen (vereinfacht, ohne KS-Extraktion)
(defun insert-rotated-block-with-ks (blockname startpunkt winkel / 
                                      rad matrix block-obj endpunkt block-laenge)
  
  (if (or (null startpunkt) (not (listp startpunkt)))
    (progn
      (princ (strcat "\n  FEHLER: Ungültiger Einfügepunkt für '" blockname "'"))
      startpunkt
    )
    (progn
      (princ (strcat "\n  Fuege Block '" blockname "' ein (Rotation " (itoa winkel) "°)"))
      
      (setq rad (* winkel (/ pi 180.0)))
      
      ;; Block direkt am Startpunkt einfügen
      (setq block-obj (vla-InsertBlock modelspace
                        (vlax-3D-point startpunkt)
                        blockname 1.0 1.0 1.0 0))
      
      ;; Rotation um Y-Achse
      (setq matrix (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-TransformBy block-obj (vlax-tmatrix matrix))
      
      ;; Blocklänge für Endpunkt-Berechnung (geschätzt)
      (setq block-laenge 300)
      (cond
        ((vl-string-search "Umlenk" blockname) (setq block-laenge 500))
        ((vl-string-search "Motor" blockname) (setq block-laenge 500))
        ((vl-string-search "Bogen" blockname) (setq block-laenge 800))
        (t (setq block-laenge 300))
      )
      
      (setq endpunkt (list (+ (car startpunkt) (* block-laenge (cos rad)))
                          (cadr startpunkt)
                          (+ (caddr startpunkt) (* (- (sin rad)) block-laenge))))
      
      (princ (strcat "\n    Endpunkt: Z=" (rtos (caddr endpunkt) 2 2)))
      endpunkt
    )
  )
)
;; ============================================================
;; TEIL 8: WINKELBERECHNUNG (NUR MIT BIBLIOTHEKSDATEN)
;; ============================================================
(defun berechne-alle-winkel (deltaL deltaH richtung /
                             winkel-list ergebnis-liste A B cos3 sin3
                             bogen-x1 bogen-z1 bogen-x2 bogen-z2
                             abs-dz-AUS abs-dz-EIN L_GF L_VF cosα sinα nenner
                             winkel mass1 mass2 gueltig)
  (dbgf "berechne-alle-winkel")

  ;; Bibliothek muss initialisiert sein
  (if (not *lib-initialized*)
    (progn
      (alert "Bibliothek nicht initialisiert!\nBefehl abbrechen und neu starten.")
      (exit)
    )
  )
  
  (setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz))
  
  ;; ALLE in der Bibliothek verfügbaren Winkel
  (setq winkel-list '(3 6 9 12 15 18 21 27 33 39 45 51))
  
  (setq ergebnis-liste '())
  (setq cos3 (cos (* 3 (/ pi 180.0))) sin3 (sin (* 3 (/ pi 180.0))))
  
  (princ "\n\n=========================================\n  BERECHNUNG FÜR ALLE WINKEL\n=========================================")
  (princ (strcat "\nΔL = " (rtos deltaL 2 2) " mm\nΔH = " (rtos deltaH 2 2) " mm\nRichtung: " richtung))
  (princ "\n\n  Winkel     Bogen-Name (Auf)        Bogen-Name (Ab)")
  (princ "\n  ---------------------------------------------------")
  
  (foreach winkel winkel-list
    ;; Bogen-Maße aus Bibliothek holen (KEIN Fallback!)
    (if (= richtung "Auf")
      (setq mass1 (get-bogen-mass bogen-auf winkel))
      (setq mass1 (get-bogen-mass bogen-ab winkel))
    )
    
    ;; Debug-Ausgabe: Welcher Bogen wird verwendet?
    (if (= richtung "Auf")
      (princ (strcat "\n  " (itoa winkel) "°        Vario_Bogen_auf_" (itoa winkel) "°"))
      (princ (strcat "\n  " (itoa winkel) "°                              Vario_Bogen_ab_" (itoa winkel) "°"))
    )
    
    (if (null mass1)
      (progn
        (princ (strcat "   → ⚠ NICHT VORHANDEN"))
        (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
      )
      (progn
        (princ (strcat "   → ✓ geladen (dx=" (rtos (car mass1) 2 0) ", dz=" (rtos (caddr mass1) 2 0) ")"))
        (setq mass2 mass1)  ;; Zweiter Bogen gleiche Maße
        (setq bogen-x1 (car mass1) bogen-z1 (caddr mass1))
        (setq bogen-x2 (car mass2) bogen-z2 (caddr mass2))
        
        (setq cosα (cos (* winkel (/ pi 180.0))) sinα (sin (* winkel (/ pi 180.0))))
        (setq A (- deltaL aus-dx ein-dx bogen-x1 bogen-x2 (* FESTE_HORIZONTAL cos3)))
        
        (if (= richtung "Auf")
          (progn
            (setq B (+ deltaH abs-dz-AUS abs-dz-EIN (- bogen-z1) (- bogen-z2) (* FESTE_HORIZONTAL sin3)))
            (setq nenner (+ (* cos3 sinα) (* sin3 cosα)))
          )
          (progn
            (setq B (- deltaH abs-dz-AUS abs-dz-EIN bogen-z1 bogen-z2 (* FESTE_HORIZONTAL sin3)))
            (setq nenner (- (* cos3 sinα) (* sin3 cosα)))
          )
        )
        
        (if (> (abs nenner) 0.0001)
          (progn
            (setq L_GF (/ (- (* A sinα) (* B cosα)) nenner))
            (if (= richtung "Auf")
              (setq L_VF (/ (+ (* B cos3) (* A sin3)) nenner))
              (setq L_VF (/ (- (* B cos3) (* A sin3)) nenner))
            )
            (if (and (numberp L_GF) (numberp L_VF))
              (progn
                (setq gueltig (and (>= L_GF 0) (>= L_VF 0)))
                (setq ergebnis-liste (cons (list winkel L_GF L_VF gueltig) ergebnis-liste))
              )
              (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
            )
          )
          (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
        )
      )
    )
  )
  
  (setq ergebnis-liste (reverse ergebnis-liste))
  
  ;; Ausgabe der Ergebnisse
  (princ "\n\n=================================================================================\n  ERGEBNISTABELLE\n=================================================================================")
  (princ "\n  Winkel     L_GF (mm)        L_VF (mm)        Status\n=================================================================================")
  
  (setq best-winkel nil best-L_GF nil best-L_VF nil)
  (foreach item ergebnis-liste
    (setq winkel (car item) L_GF (cadr item) L_VF (caddr item) gueltig (cadddr item))
    (if (and (numberp L_GF) (numberp L_VF))
      (progn
        (princ (strcat "\n  " (itoa winkel) "°       " (fmt L_GF) " mm     " (fmt L_VF) " mm     "))
        (if gueltig
          (progn
            (princ "✓ GÜLTIG")
            ;; Wähle den kleinsten gültigen Winkel (wegen Herstellungskosten)
            (if (or (null best-winkel) (< winkel best-winkel))
              (setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
            )
          )
          (princ "✗ UNGÜLTIG (negative Länge)")
        )
      )
      (princ (strcat "\n  " (itoa winkel) "°       ---           ---           ✗ FEHLER"))
    )
  )
  (princ "\n=================================================================================")
  
  ;; Ausgabe des empfohelnen Winkels
  (if best-winkel
    (princ (strcat "\n\n>>> Empfohlener Winkel: " (itoa best-winkel) 
                   "° (kleinster verfuegbarer Winkel)"))
    (princ "\n\n>>> KEIN passender Winkel gefunden!"))

  (dbgreturn (list best-winkel best-L_GF best-L_VF ergebnis-liste))
)

;; ============================================================
;; TEIL 9: MODULE EINFÜGEN (GESAMTE ANLAGE)
;; ============================================================
(defun foerderanlage-einfuegen (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt)
  (setq aktueller-punkt startpunkt)
  
  (if (not *lib-initialized*) (init-bibliothek))
  
  ;; 1. AUS_Element
  (princ "\n\n1/11: _3D_AS_90_links (0°)")
  (setq aktueller-punkt (insert-block-by-ks "_3D_AS_90_links" aktueller-punkt))
  
  ;; 2. 1. Gefällestrecke
  (if (> L_GF1 0.1)
    (progn
      (princ (strcat "\n\n2/11: Gefaellestrecke (3°, Laenge=" (rtos L_GF1 2 2) " mm)"))
      (setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3))
    )
    (princ "\n\n2/11: (uebersprungen)")
  )
  
  ;; 3. Separator
  (princ "\n\n3/11: Separator (300mm, 3° geneigt)")
  (setq aktueller-punkt (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt 3))
  
  ;; 4. Umlenkstation
  (princ "\n\n4/11: Umlenkstation (500mm, 3° geneigt)")
  (setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3))
  
  ;; 5. 1. Vertikalbogen
  (if (= richtung "Auf")
    (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
    (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
  )
  (princ (strcat "\n\n5/11: " bogen-name " (3° geneigt)"))
  (setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt 3))
  
  ;; 6. Variable Strecke L_VF
  (if (> L_VF 0.1)
    (progn
      (if (= richtung "Auf")
        (progn
          (princ (strcat "\n\n6/11: Steigungsstrecke (" (itoa best-winkel) "°, Laenge=" (rtos L_VF 2 2) " mm)"))
          (setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_VF (- best-winkel)))
        )
        (progn
          (princ (strcat "\n\n6/11: Gefaellestrecke (" (itoa best-winkel) "°, Laenge=" (rtos L_VF 2 2) " mm)"))
          (setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_VF best-winkel))
        )
      )
    )
    (princ "\n\n6/11: (uebersprungen)")
  )
  
  ;; 7. 2. Vertikalbogen
  (if (= richtung "Auf")
    (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
    (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
  )
  (princ (strcat "\n\n7/11: " bogen-name " (3° geneigt)"))
  (setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt (- best-winkel)))
  
  ;; 8. Motorstation
  (princ "\n\n8/11: Motorstation (500mm, 3° geneigt)")
  (setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 3))
  
  ;; 9. 2. Gefällestrecke
  (if (> L_GF2 0.1)
    (progn
      (princ (strcat "\n\n9/11: Gefaellestrecke (3°, Laenge=" (rtos L_GF2 2 2) " mm)"))
      (setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF2 3))
    )
    (princ "\n\n9/11: (uebersprungen)")
  )
  
  ;; 10. Separator 2
  (princ "\n\n10/11: Separator (300mm, 3° geneigt)")
  (setq aktueller-punkt (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt 3))
  
  ;; 11. EIN_Element
  (princ "\n\n11/11: _3D_ES_90_links (0°)")
  (setq endpunkt (insert-block-by-ks "_3D_ES_90_links" aktueller-punkt))
  
  (princ "\n\n=========================================")
  (princ "\n>>> Förderanlage erfolgreich eingefügt! <<<")
  (princ "\n=========================================")
  
  endpunkt
)
;; ============================================================
;; TEIL 10: HAUPTFUNKTION
;; ============================================================
(defun c:FOERDERANLAGE ( / eingabe-modus line-points startpunkt endpunkt differenz
                           deltaL deltaH deltaX deltaY richtung ergebnis
                           best-winkel L_GF L_GF1 L_GF2 L_VF ergebnis-liste
                           antwort verteilung-modus)
  (dbgf "c:FOERDERANLAGE")

  (princ "\n=========================================")
  (princ "\n     FÖRDERANLAGE GENERATOR v25.0")
  (princ "\n    (Komplett bibliotheksbasiert)")
  (princ "\n=========================================")
  
  ;; Bibliothek initialisieren
  (if (not (init-bibliothek))
    (progn
      (alert "Fehler beim Initialisieren der Bibliothek!\nBitte Pfade prüfen.")
      (exit)
    )
  )
  
  (princ "\n\nEingabemodus wählen:")
  (princ "\n  1 - 3D-Linie auswählen (Start- und Endpunkt mit Höhe)")
  (princ "\n  2 - Werte manuell eingeben")
  (setq antwort (getstring "\nIhre Wahl (1/2): "))
  
  (cond
    ((= antwort "1") (setq eingabe-modus "Linie"))
    ((= antwort "2") (setq eingabe-modus "Wert"))
    (t (setq eingabe-modus "Linie") (princ "\nUngültige Eingabe, Modus '3D-Linie auswählen'"))
  )
  
  (if (= eingabe-modus "Linie")
    (progn
      (princ "\n\n>>> MODUS: 3D-Linie auswählen <<<")
      ;; BKS auf WCS setzen für korrekte Z-Erfassung
      (command "BKS" "W")
      (princ "\n✓ BKS auf Weltkoordinaten gesetzt - Z-Höhe wird korrekt erfasst!")
      
     
      (setq line-points 
        (get-line-start-end-points
          "\nBitte 3D-Linie (oder Polylinie) für die Förderstrecke auswählen:"))
      
      (if (null line-points) 
        (progn (alert "Keine gültige Linie ausgewählt!") (exit))
      )
      
      (setq startpunkt (car line-points))
      (setq endpunkt (cadr line-points))
      
      (princ (strcat "\n  → Start-Z-Höhe: " (rtos (caddr startpunkt) 2 2) " mm"))
      (princ (strcat "\n  → End-Z-Höhe:   " (rtos (caddr endpunkt) 2 2) " mm"))
      
      (setq differenz (punkt-differenz startpunkt endpunkt))
      (setq deltaX (abs (car differenz)))
      (setq deltaY (abs (cadr differenz)))
      (setq deltaH (caddr differenz))
      
      ;; Verwende die größere horizontale Distanz als Förderlänge
      (setq deltaL (max deltaX deltaY))
      
      (princ (strcat "\n  → Horizontale Distanzen: ΔX = " (rtos deltaX 2 2) " mm, ΔY = " (rtos deltaY 2 2) " mm"))
      (princ (strcat "\n  → Gewählte Förderlänge ΔL = " (rtos deltaL 2 2) " mm (die größere Distanz)"))
      (princ "\n\n=========================================")
      (princ (strcat "\nGemessene Werte (aus 3D-Linie):\n  ΔL = " (rtos deltaL 2 2) " mm\n  ΔH = " (rtos deltaH 2 2) " mm"))
      
      ;; Richtung der Förderanlage (X oder Y) - für spätere Rotation
      (if (> deltaY deltaX)
        (princ "\n  → Förderanlage wird in Y-Richtung erstellt")
        (princ "\n  → Förderanlage wird in X-Richtung erstellt")
      )
      
      (if (>= deltaH 0)
        (progn (setq richtung "Auf") (princ "\n\nFörderrichtung: AUF (nach oben)"))
        (progn (setq richtung "Ab") (setq deltaH (abs deltaH)) (princ "\n\nFörderrichtung: AB (nach unten)"))
      )
      
      (setq startpunkt-fuer-einfuegen startpunkt)
    )
    (progn
      (princ "\n\n>>> MODUS: Manuelle Werteingabe <<<")
      (setq deltaL (getreal "\nHorizontale Distanz ΔL (mm): "))
      (if (null deltaL) (setq deltaL 15000))
      (setq deltaH (getreal "\nHöhendifferenz |ΔH| (mm): "))
      (if (null deltaH) (setq deltaH 3000))
      (princ "\nFörderrichtung wählen:\n  1 - AUF (nach oben)\n  2 - AB (nach unten)")
      (setq antwort (getstring "\nIhre Wahl (1/2): "))
      (if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf"))
      (setq startpunkt-fuer-einfuegen (getpoint "\nStartpunkt für AUS_Element wählen: "))
      (if (null startpunkt-fuer-einfuegen) (setq startpunkt-fuer-einfuegen '(0 0 0)))
    )
  )
  
  ;; Berechnung
  (setq ergebnis (berechne-alle-winkel deltaL deltaH richtung))
  (setq best-winkel (car ergebnis) L_GF (cadr ergebnis) L_VF (caddr ergebnis))
  
  (if (or (null best-winkel) (null L_GF) (null L_VF) (<= L_GF 0) (<= L_VF 0))
    (progn 
      (alert (strcat "Kein passender Winkel gefunden!\n\n"
                     "ΔL=" (rtos deltaL 2 0) " mm, ΔH=" (rtos deltaH 2 0) " mm, Richtung=" richtung
                     "\nBitte andere Werte versuchen."))
      (exit)
    )
  )
  
  (princ "\n\n=========================================")
  (princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) "°"))
  (princ (strcat "\n>>> L_GF (gesamt): " (rtos L_GF 2 2) " mm"))
  (princ (strcat "\n>>> L_VF: " (rtos L_VF 2 2) " mm"))
  (princ "\n=========================================")
  
  ;; Verteilung der Gefällestrecken
  (princ "\n\nVerteilung der Gefaellestrecken (vorne/hinten):")
  (princ "\n  1 - Gleichmaessig (L_GF1 = L_GF2 = L_GF/2)")
  (princ "\n  2 - Vorne Minimum, hinten Rest")
  (princ "\n  3 - Hinten Minimum, vorne Rest")
  (princ "\n  4 - Eigene Werte eingeben")
  (setq verteilung-modus (getstring "\nIhre Wahl (1/2/3/4) [1]: "))
  (if (= verteilung-modus "") (setq verteilung-modus "1"))
  
  (cond
    ((= verteilung-modus "1")
      (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
    ((= verteilung-modus "2")
      (setq L_GF1 staustrecke-basis)
      (setq L_GF2 (- L_GF staustrecke-basis))
      (if (< L_GF2 0) (setq L_GF2 0)))
    ((= verteilung-modus "3")
      (setq L_GF2 staustrecke-basis)
      (setq L_GF1 (- L_GF staustrecke-basis))
      (if (< L_GF1 0) (setq L_GF1 0)))
    ((= verteilung-modus "4")
      (setq L_GF1 (getreal (strcat "\nL_GF1 vorne (mm) [" (rtos (/ L_GF 2.0) 2 2) "]: ")))
      (if (null L_GF1) (setq L_GF1 (/ L_GF 2.0)))
      (setq L_GF2 (- L_GF L_GF1))
      (if (< L_GF2 0) (setq L_GF2 0))
      (princ (strcat "\n  L_GF2 hinten (berechnet): " (rtos L_GF2 2 2) " mm")))
    (t
      (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
  )
  
  (princ (strcat "\n\n>>> L_GF1 (vorne): " (rtos L_GF1 2 2) " mm"))
  (princ (strcat "\n>>> L_GF2 (hinten): " (rtos L_GF2 2 2) " mm"))
  
  (princ "\n\nMöchten Sie die Förderanlage einfügen?\n  1 - Ja, Module einfügen\n  2 - Nein, abbrechen")
  (setq antwort (getstring "\nIhre Wahl (1/2): "))
  
  (if (= antwort "1")
    (foerderanlage-einfuegen deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt-fuer-einfuegen)
    (princ "\nVorgang abgebrochen.")
  )

  (dbgreturn nil)
)
;; ============================================================
;; START
;; ============================================================
(princ "\n=========================================")
(princ "\n>>> FOERDERANLAGE GENERATOR v25.0 geladen <<<")
(princ "\n>>> Befehle: FOERDERANLAGE <<<")
(princ "\n>>> 100% bibliotheksbasiert - KEINE Fallbacks <<<")
(princ "\n=========================================")
(princ)