Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros

.gitignore

@@ -183,3 +183,5 @@ cython_debug/
 
 # BricsCAD kompilierte Menuedateien
 *.cui
+data/block_libraries/ils_library.dxf >> .gitignore
+echo data/block_libraries/ils_library.dxf

Lisp/KreiselInsert.lsp

@@ -16,19 +16,47 @@
   (setq #Eckrad_LetzteNr 0)
 )
 
-;; Block-Pfad
+;; Block-Pfad (gesetzt durch bin/setenv.bat -> DXFM_BLOCKS = data\ils\2D)
 (setq block-pfad (getenv "DXFM_BLOCKS"))
 
 (if (or (null block-pfad) (= block-pfad ""))
   (progn
-    (setq block-pfad "C:/Users/y.wang/Documents/dxfmakros/Blocks/")
-    (alert (strcat "Umgebungsvariable DXFM_BLOCKS nicht gefunden.\nNutze Standardpfad: " block-pfad))
+    (alert "DXFM_BLOCKS nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.")
+    (exit)
   )
   (setq block-pfad (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" block-pfad)) "/"))
 )
 
 (setq *block-path* block-pfad)
-(princ (strcat "\nBlock-Pfad aktiv: " block-pfad))
+(princ (strcat "\nBlock-Pfad: " block-pfad))
+
+;; ssg_core laden falls noch nicht geschehen (Schutz bei direktem Laden ohne ssg-ensure)
+(if (null (car (atoms-family 1 '("SSG-CFG-OR"))))
+  (progn
+    (setq *ssg-core-datei*
+      (cond
+        ((getenv "DXFM_LISP")
+         (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_core.lsp"))
+        ((findfile "ssg_core.lsp")
+         (findfile "ssg_core.lsp"))
+        (t nil)
+      )
+    )
+    (if *ssg-core-datei*
+      (progn
+        (load *ssg-core-datei*)
+        (if (car (atoms-family 1 '("SSG-LOAD-CONFIG"))) (ssg-load-config))
+        (princ (strcat "\n[KreiselInsert] ssg_core geladen: " *ssg-core-datei*))
+      )
+      (progn
+        (defun ssg-cfg-or (sektion schluessel standard) standard)
+        (defun ssg-cfg   (sektion schluessel) nil)
+        (defun ssg-load-config () nil)
+        (princ "\n[KreiselInsert] WARNUNG: ssg_core.lsp nicht gefunden - Standardwerte.")
+      )
+    )
+  )
+)
 
 ;; Kreisel-Geometrie-Konstanten (aus Config oder Fallback)
 (setq *kreisel-durchmesser*    (ssg-cfg-or "kreisel" "durchmesser" 800.0))

Lisp/vf_core.lsp

@@ -0,0 +1,894 @@
+;; ============================================================
+;; VF_CORE - VarioFoerderer Kern-Modul
+;; Version: 26.0
+;; Architektur: Plugin/Dispatcher
+;; Laedt automatisch: vf_standard.lsp, vf_etage.lsp
+;; Befehle: VarioFoerderer (Alias: FOERDERANLAGE, ETAGEVARIOFOERDERER)
+;; ============================================================
+
+(vl-load-com)
+
+;; ============================================================
+;; TEIL 1: ABHAENGIGKEITEN
+;; ============================================================
+(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)
+  )
+)
+
+(setq block-pfad modul-pfad)
+
+(if (not *ssg-core-loaded*)
+  (if (getenv "DXFM_LISP")
+    (progn
+      (load (strcat (getenv "DXFM_LISP") "/ssg_core.lsp"))
+      (ssg-load-config)
+      (setq *ssg-core-loaded* t)
+    )
+    (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.")
+  )
+)
+
+(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
+(setq modelspace (vla-get-ModelSpace doc))
+
+;; ============================================================
+;; TEIL 2: TYP-REGISTRY
+;; ============================================================
+(if (null *vf-typ-registry*) (setq *vf-typ-registry* nil))
+(if (null *vf-vorauswahl-typ*) (setq *vf-vorauswahl-typ* nil))
+
+;; Registriert einen Foerderanlagen-Typ.
+;; berechne-fn:  '(lambda (deltaL deltaH richtung seite) ...)
+;;               Ruft init-Bibliothek und Winkelberechnung auf.
+;;               Gibt zurueck: (list best-winkel best-L_GF best-L_VF ergebnis-liste)
+;; einfuege-fn: '(lambda (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite) ...)
+;;               Fuegt alle Bloecke ein. Gibt endpunkt zurueck.
+(defun vf-typ-registrieren (typ-name berechne-fn einfuege-fn beschreibung)
+  (if (assoc typ-name *vf-typ-registry*)
+    (princ (strcat "\n  Typ '" typ-name "' bereits registriert."))
+    (setq *vf-typ-registry*
+      (append *vf-typ-registry*
+              (list (list typ-name berechne-fn einfuege-fn beschreibung))))
+  )
+)
+
+;; ============================================================
+;; TEIL 3: GLOBALE VARIABLEN
+;; ============================================================
+(if (null #VF_LetzteNr) (setq #VF_LetzteNr 0))
+(setq *library-loaded* nil)
+(setq *ks-cache* nil)
+(setq grad-zeichen (chr 176))
+
+;; 26 Attribut-Definitionen fuer VF_*-Block (alle Typen)
+(setq *vf-attrib-defs*
+  '(("NUMMER"               "0")
+    ("MONTAGEHOEHE_m"       "0.000")
+    ("HOEHE_VON"            "0")
+    ("HOEHE_BIS"            "0")
+    ("DELTA_H"              "0")
+    ("DELTA_L"              "0")
+    ("L_VF_m"               "0.000")
+    ("L_GF_m"               "0.000")
+    ("ANTRIEBFAHRTRICHTUNG" "Auf")
+    ("WINKEL"               "0")
+    ("ANZAHL_SEPARATOR"     "2")
+    ("ANZAHL_SCANNER"       "0")
+    ("TYP"                  "standard")
+    ("SEITE"                "rechts")
+    ("GF_Bogen_L_90"        "0")
+    ("GF_Bogen_L_60"        "0")
+    ("GF_Bogen_L_30"        "0")
+    ("GF_Bogen_R_90"        "0")
+    ("GF_Bogen_R_60"        "0")
+    ("GF_Bogen_R_30"        "0")
+    ("VF_Bogen_A_90"        "0")
+    ("VF_Bogen_A_60"        "0")
+    ("VF_Bogen_A_30"        "0")
+    ("VF_Bogen_I_90"        "0")
+    ("VF_Bogen_I_60"        "0")
+    ("VF_Bogen_I_30"        "0")))
+
+;; ============================================================
+;; TEIL 4: 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")
+    ((and (> len 99) (< len 101)) "X")
+    ((and (> len 1.5) (< len 2.5)) "Y")
+    ((and (> len 2.5) (< len 3.5)) "Z")
+    (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))))
+
+(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))
+
+(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 5: KS_EIN/KS_AUS EXTRAKTION
+;; ============================================================
+(defun ensure-block-loaded (blockname / lib-datei block-datei temp-obj)
+  (if (not (tblsearch "BLOCK" blockname))
+    (progn
+      (if *library-loaded* (setq *library-loaded* nil))
+      (if (not *library-loaded*)
+        (progn
+          (setq lib-datei
+            (strcat (vl-string-translate "\\" "/" (getenv "DXFM_DATA"))
+                    "/block_libraries/ils_library.dxf"))
+          (if (findfile lib-datei)
+            (progn
+              (princ "\n  Lade ils_library.dxf ...")
+              (setq temp-obj (vla-InsertBlock modelspace
+                               (vlax-3D-point '(0 0 0))
+                               lib-datei 1.0 1.0 1.0 0))
+              (vla-Delete temp-obj)
+              (setq *library-loaded* T)
+              (princ " OK")
+            )
+            (princ (strcat "\n  WARNUNG: Bibliothek nicht gefunden: " lib-datei))
+          )
+        )
+      )
+      (if (not (tblsearch "BLOCK" blockname))
+        (progn
+          (setq block-datei (strcat block-pfad blockname ".dxf"))
+          (if (findfile block-datei)
+            (progn
+              (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 (strcat "\n  FEHLER: Block nicht gefunden: " blockname))
+          )
+        )
+      )
+    )
+  )
+)
+
+(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)
+  (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
+)
+
+(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 *ks-cache*))
+  (if cached
+    (ks-absolutize (cdr cached) insert-pt)
+    (progn
+      (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*))
+        )
+      )
+      result
+    )
+  )
+)
+
+;; ============================================================
+;; TEIL 6: PUNKTE-AUSWAHL
+;; ============================================================
+(defun get-3d-point-from-object (msg / ent obj pt variant)
+  (princ msg)
+  (princ "\n  >> Objekt (Block) waehlen: ")
+  (setq ent (entsel))
+  (if ent
+    (progn
+      (setq obj (vlax-ename->vla-object (car ent)))
+      (if (vlax-property-available-p obj 'InsertionPoint)
+        (progn
+          (setq variant (vla-get-InsertionPoint obj))
+          (setq pt (vlax-safearray->list (vlax-variant-value variant)))
+          (princ (strcat "\n  Block-Einfuegepunkt: X=" (rtos (car pt) 2 3)
+                         " Y=" (rtos (cadr pt) 2 3) " Z=" (rtos (caddr pt) 2 3)))
+        )
+        (progn
+          (setq pt (cadr ent))
+          (princ (strcat "\n  Punkt auf Objekt: Z=" (rtos (caddr pt) 2 2) " mm"))
+        )
+      )
+    )
+    (progn
+      (princ "\n  Kein Objekt gewaehlt.")
+      (setq pt nil)
+    )
+  )
+  pt
+)
+
+(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt)
+  (princ msg)
+  (princ "\n  >> 3D-Linie oder Polylinie waehlen: ")
+  (setq ent (entsel))
+  (if ent
+    (progn
+      (setq obj (vlax-ename->vla-object (car ent)))
+      (setq obj-name (vla-get-ObjectName obj))
+      (cond
+        ((= 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:"
+                        "\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)))
+        )
+        ((= obj-name "AcDbPolyline")
+         (setq start-pt (vlax-curve-getStartPoint obj))
+         (setq end-pt (vlax-curve-getEndPoint obj))
+         (princ (strcat "\n  3D-Polylinie:"
+                        "\n     Start Z=" (rtos (caddr start-pt) 2 2)
+                        " Ende Z=" (rtos (caddr end-pt) 2 2)))
+        )
+        (t
+         (princ "\n  FEHLER: Keine Linie oder Polylinie ausgewaehlt!")
+         (setq start-pt nil end-pt nil)
+        )
+      )
+    )
+    (progn
+      (princ "\n  Kein Objekt gewaehlt.")
+      (setq start-pt nil end-pt nil)
+    )
+  )
+  (if (and start-pt end-pt) (list start-pt end-pt) nil)
+)
+
+;; ============================================================
+;; TEIL 7: VF-NUMMERIERUNG
+;; ============================================================
+(defun vf-next-number ( / ss i nr maxnr attribs)
+  (setq maxnr 0)
+  (setq ss (ssget "X" '((0 . "INSERT") (2 . "VF_*"))))
+  (if ss
+    (progn
+      (setq i 0)
+      (while (< i (sslength ss))
+        (setq attribs (ssg-attrib-read (ssname ss i)))
+        (foreach pair attribs
+          (if (= (car pair) "NUMMER")
+            (progn
+              (setq nr (atoi (cdr pair)))
+              (if (> nr maxnr) (setq maxnr nr))
+            )
+          )
+        )
+        (setq i (1+ i))
+      )
+    )
+  )
+  (setq #VF_LetzteNr (max #VF_LetzteNr maxnr))
+  (setq #VF_LetzteNr (1+ #VF_LetzteNr))
+  #VF_LetzteNr
+)
+
+;; ============================================================
+;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen)
+;; ============================================================
+(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: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
+      (exit)
+    )
+  )
+  (ensure-block-loaded blockname)
+  (if (not (tblsearch "BLOCK" blockname))
+    (progn
+      (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
+      (exit)
+    )
+  )
+  (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
+    )
+  )
+)
+
+(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
+      (ensure-block-loaded blockname)
+      (if (not (tblsearch "BLOCK" blockname))
+        (progn
+          (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
+          (exit)
+        )
+      )
+      (princ (strcat "\n  Fuege '" blockname "' ein"
+                     " (L=" (rtos laenge 2 2) " mm, W=" (itoa winkel) (chr 176) ")"))
+      (setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0)))
+      (setq rad (* winkel (/ pi 180.0)))
+      (setq block-obj (vla-InsertBlock modelspace
+                        (vlax-3D-point '(0 0 0))
+                        blockname scale 1.0 1.0 0))
+      (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))
+      (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    Endpunkt: Z=" (rtos (caddr endpunkt) 2 2)))
+      endpunkt
+    )
+  )
+)
+
+(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz /
+                                      rad matrix block-obj endpunkt)
+  (if (or (null startpunkt) (not (listp startpunkt)))
+    (progn
+      (princ (strcat "\n  FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
+      startpunkt
+    )
+    (progn
+      (ensure-block-loaded blockname)
+      (if (not (tblsearch "BLOCK" blockname))
+        (progn
+          (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
+          (exit)
+        )
+      )
+      (princ (strcat "\n  Fuege Block '" blockname "' ein"
+                     " (Rotation " (itoa winkel) (chr 176) ")"))
+      (setq rad (* winkel (/ pi 180.0)))
+      (setq block-obj (vla-InsertBlock modelspace
+                        (vlax-3D-point '(0 0 0))
+                        blockname 1.0 1.0 1.0 0))
+      (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))
+      (vla-Move block-obj
+        (vlax-3D-point '(0 0 0))
+        (vlax-3D-point startpunkt))
+      (setq endpunkt (list
+        (+ (car startpunkt)   (+ (* block-dx (cos rad)) (* block-dz (sin rad))))
+        (cadr startpunkt)
+        (+ (caddr startpunkt) (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz)))))
+      (princ (strcat "\n    Endpunkt: X=" (rtos (car endpunkt) 2 2)
+                     " Z=" (rtos (caddr endpunkt) 2 2)))
+      endpunkt
+    )
+  )
+)
+
+;; ============================================================
+;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE
+;; ============================================================
+(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
+                                deltaL deltaH deltaX deltaY richtung antwort)
+  (princ "\n\nEingabemodus waehlen:")
+  (princ "\n  1 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)")
+  (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 "\nModus: 3D-Linie"))
+  )
+  (if (= eingabe-modus "Linie")
+    (progn
+      (princ "\n\n>>> MODUS: 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 Foerderstrecke 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))
+            deltaH (caddr differenz))
+      (setq deltaL (max deltaX deltaY))
+      (princ (strcat "\n  △L=" (rtos deltaL 2 2) " mm"
+                     "  △H=" (rtos deltaH 2 2) " mm"))
+      (if (>= deltaH 0)
+        (progn (setq richtung "Auf") (princ "\n  Foerderrichtung: AUF"))
+        (progn (setq richtung "Ab") (setq deltaH (abs deltaH))
+               (princ "\n  Foerderrichtung: AB"))
+      )
+    )
+    (progn
+      (princ "\n\n>>> MODUS: Manuelle Werteingabe <<<")
+      (setq deltaL (getreal "\n△L - Horizontale Distanz (mm): "))
+      (if (null deltaL) (setq deltaL 15000))
+      (setq deltaH (getreal "\n△H - Hoehenunterschied (mm): "))
+      (if (null deltaH) (setq deltaH 3000))
+      (princ "\nFoerderrichtung:\n  1 - AUF\n  2 - AB")
+      (setq antwort (getstring "\nIhre Wahl (1/2): "))
+      (if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf"))
+      (setq startpunkt (getpoint "\nStartpunkt fuer AUS_Element waehlen: "))
+      (if (null startpunkt) (setq startpunkt '(0 0 0)))
+    )
+  )
+  (list deltaL deltaH richtung startpunkt)
+)
+
+;; ============================================================
+;; TEIL 10: VF_*-BLOCK-SYSTEM (gemeinsam fuer alle Typen)
+;; ============================================================
+(defun vf-make-label (vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
+                      richtung best-winkel n-separator n-scanner startpunkt /
+                      label-txt label-pt L_VF_str L_GF_str delta-sym)
+  (setq delta-sym (chr 916))
+  (setq L_VF_str (vl-string-subst "," "." (rtos (/ L_VF 1000.0) 2 3)))
+  (setq L_GF_str (vl-string-subst "," "." (rtos (/ L_GF 1000.0) 2 3)))
+  (setq label-txt
+    (strcat "VF" (itoa vf-nummer)
+            ": von " (itoa (fix hoehe-von)) "mm bis " (itoa (fix hoehe-bis)) "mm, "
+            delta-sym "H=" (itoa (fix deltaH)) "mm; "
+            delta-sym "L=" (itoa (fix deltaL)) "mm; "
+            "VF:" L_VF_str "m; GF:" L_GF_str "m; "
+            richtung ": " (itoa best-winkel) grad-zeichen "; "
+            "Sep: " (itoa n-separator) "; Scan: " (itoa n-scanner)))
+  (setq label-pt (list
+    (+ (car startpunkt) (/ deltaL 2.0))
+    (- (cadr startpunkt) 200.0)
+    (caddr startpunkt)))
+  (entmake (list
+    '(0 . "TEXT")
+    (cons 8 "VF_Beschriftung")
+    '(67 . 0)
+    (cons 10 label-pt)
+    (cons 40 100.0)
+    (cons 1 label-txt)
+    (cons 50 0.0)
+    '(72 . 1)
+    '(73 . 2)
+    (cons 11 label-pt)
+  ))
+)
+
+;; Erstellt VF_N-Block aus allen seit lastEnt erzeugten Entities.
+;; Setzt Attributwerte entsprechend Typ, Seite und Geometrieparametern.
+(defun vf-block-erstellen (anlage-typ seite vf-nummer n-scanner
+                            hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
+                            richtung best-winkel startpunkt lastEnt
+                            / vf-bname vf-ss vf-e vf-insert montagehoehe-m attdef-ypos)
+  ;; Beschriftungstext erzeugen
+  (vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
+                 richtung best-winkel 2 n-scanner startpunkt)
+
+  ;; Unsichtbare ATTDEFs am Startpunkt erzeugen
+  (setq attdef-ypos (cadr startpunkt))
+  (foreach def *vf-attrib-defs*
+    (entmake (list
+      '(0 . "ATTDEF")
+      '(8 . "0")
+      '(67 . 0)
+      (cons 10 (list (car startpunkt) attdef-ypos (caddr startpunkt)))
+      '(40 . 50.0)
+      (cons 1 (cadr def))
+      (cons 3 (car def))
+      (cons 2 (car def))
+      '(70 . 1)
+    ))
+    (setq attdef-ypos (- attdef-ypos 100.0))
+  )
+
+  ;; Alle neuen Entities seit lastEnt sammeln
+  (setq vf-ss (ssadd))
+  (if lastEnt
+    (setq vf-e (entnext lastEnt))
+    (setq vf-e (entnext))
+  )
+  (while vf-e
+    (ssadd vf-e vf-ss)
+    (setq vf-e (entnext vf-e))
+  )
+
+  ;; Block erstellen, einfuegen, Attribute setzen
+  (setq vf-bname (strcat "VF_" (itoa vf-nummer)))
+  (if (> (sslength vf-ss) 0)
+    (progn
+      (setvar "ATTREQ" 0)
+      (setvar "ATTDIA" 0)
+      (command "_.-BLOCK" vf-bname startpunkt vf-ss "")
+      (command "_.INSERT" vf-bname startpunkt 1.0 1.0 0.0)
+      (setvar "ATTREQ" 1)
+      (setq vf-insert (entlast))
+      (setq montagehoehe-m (/ (+ hoehe-von hoehe-bis) 2000.0))
+      (ssg-attrib-set-on vf-insert
+        (list
+          (cons "NUMMER"               (itoa vf-nummer))
+          (cons "MONTAGEHOEHE_m"       (rtos montagehoehe-m 2 3))
+          (cons "HOEHE_VON"            (itoa (fix hoehe-von)))
+          (cons "HOEHE_BIS"            (itoa (fix hoehe-bis)))
+          (cons "DELTA_H"              (itoa (fix deltaH)))
+          (cons "DELTA_L"              (itoa (fix deltaL)))
+          (cons "L_VF_m"               (rtos (/ L_VF 1000.0) 2 3))
+          (cons "L_GF_m"               (rtos (/ L_GF 1000.0) 2 3))
+          (cons "ANTRIEBFAHRTRICHTUNG" richtung)
+          (cons "WINKEL"               (itoa best-winkel))
+          (cons "ANZAHL_SEPARATOR"     "2")
+          (cons "ANZAHL_SCANNER"       (itoa n-scanner))
+          (cons "TYP"                  anlage-typ)
+          (cons "SEITE"                seite)
+        )
+      )
+      ;; Typ-spezifische Bogen-Zaehler (Etage: 2x Gefaellebogen je Seite)
+      (if (= anlage-typ "etage")
+        (if (= seite "rechts")
+          (ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_R_60" "2")))
+          (ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_L_60" "2")))
+        )
+      )
+      (princ (strcat "\n>>> Block '" vf-bname "' erstellt und eingefuegt."))
+    )
+    (princ "\n>>> FEHLER: Keine Entities fuer Block gefunden!")
+  )
+)
+
+;; ============================================================
+;; TEIL 11: UNTERMODULE LADEN
+;; ============================================================
+;; Guard: Untermodule nur beim ersten Laden von vf_core.lsp ausfuehren.
+(if (not *ssg-vf-submodule-loaded*)
+  (if (getenv "DXFM_LISP")
+    (progn
+      (load (strcat (getenv "DXFM_LISP") "/vf_standard.lsp"))
+      (load (strcat (getenv "DXFM_LISP") "/vf_etage.lsp"))
+      (setq *ssg-vf-submodule-loaded* t)
+    )
+    (alert "DXFM_LISP nicht gesetzt - Untermodule konnten nicht geladen werden!")
+  )
+)
+
+;; ============================================================
+;; TEIL 12: DISPATCHER c:VarioFoerderer
+;; ============================================================
+(defun c:VarioFoerderer ( / typ-eintr anlage-typ berechne-fn einfuege-fn
+                            eingabe deltaL deltaH richtung startpunkt seite
+                            ergebnis ergebnis-liste gueltige-winkel
+                            best-winkel L_GF L_GF1 L_GF2 L_VF
+                            idx eintrag wahl antwort verteilung-modus
+                            n-scanner vf-nummer hoehe-von hoehe-bis lastEnt
+                            staustrecke-basis)
+
+  (princ "\n=========================================")
+  (princ "\n     VARIOFOERDERER GENERATOR v26.0")
+  (princ "\n=========================================")
+
+  ;; 1. Typ aus Registry waehlen
+  (if (null *vf-typ-registry*)
+    (progn
+      (alert "Keine Typen registriert!\nvf_standard.lsp und vf_etage.lsp pruefen.")
+      (exit)
+    )
+  )
+
+  (if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
+    (progn
+      (setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
+      (princ (strcat "\n>>> Typ vorgewaehlt: " *vf-vorauswahl-typ*))
+      (setq *vf-vorauswahl-typ* nil)
+    )
+    (progn
+      (setq *vf-vorauswahl-typ* nil)
+      (princ "\n\nAnlagen-Typ waehlen:")
+      (setq idx 1)
+      (foreach eintr *vf-typ-registry*
+        (princ (strcat "\n  " (itoa idx) " - " (nth 3 eintr)))
+        (setq idx (1+ idx))
+      )
+      (setq wahl (getint (strcat "\nIhre Wahl (1-"
+                                 (itoa (length *vf-typ-registry*)) ") [1]: ")))
+      (if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*)))
+        (setq wahl 1))
+      (setq typ-eintr (nth (1- wahl) *vf-typ-registry*))
+    )
+  )
+  (setq anlage-typ  (nth 0 typ-eintr))
+  (setq berechne-fn (nth 1 typ-eintr))
+  (setq einfuege-fn (nth 2 typ-eintr))
+  (princ (strcat "\n>>> Typ: " anlage-typ))
+
+  ;; 2. VF-Nummer automatisch ermitteln
+  (setq vf-nummer (vf-next-number))
+  (princ (strcat "\n>>> Naechste VF-Nummer: VF" (itoa vf-nummer)))
+
+  ;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt)
+  (setq eingabe (vf-eingabe-abfragen))
+  (setq deltaL    (nth 0 eingabe)
+        deltaH    (nth 1 eingabe)
+        richtung  (nth 2 eingabe)
+        startpunkt (nth 3 eingabe))
+
+  ;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht)
+  (princ "\n\nSeite waehlen:")
+  (princ "\n  1 - Rechts")
+  (princ "\n  2 - Links")
+  (setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
+  (if (= antwort "2") (setq seite "links") (setq seite "rechts"))
+  (princ (strcat "\n>>> Seite: " seite))
+
+  ;; 5. Typ-spezifische Berechnung (init + berechne)
+  (setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
+  (setq ergebnis-liste (cadddr ergebnis))
+
+  ;; 6. Konfiguration (nach ssg_core-Init verfuegbar)
+  (setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
+
+  ;; 7. Gueltige Winkel ermitteln
+  (setq gueltige-winkel
+    (mapcar 'car
+      (vl-remove-if-not
+        (function (lambda (e) (and (nth 3 e)
+                                   (numberp (nth 1 e)) (numberp (nth 2 e))
+                                   (>= (nth 1 e) 0) (>= (nth 2 e) 0))))
+        ergebnis-liste)))
+  (if (null gueltige-winkel)
+    (progn
+      (alert (strcat "Kein passender Winkel gefunden!\n"
+                     "△L=" (rtos deltaL 2 0) " mm, △H="
+                     (rtos deltaH 2 0) " mm, Richtung=" richtung))
+      (exit)
+    )
+  )
+
+  ;; 8. Winkelauswahl (automatisch oder interaktiv)
+  (if (= (length gueltige-winkel) 1)
+    (progn
+      (setq best-winkel (car gueltige-winkel))
+      (setq eintrag (assoc best-winkel ergebnis-liste))
+      (setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
+      (princ (strcat "\n\n>>> Einziger gueltiger Winkel: "
+                     (itoa best-winkel) (chr 176)))
+    )
+    (progn
+      (princ "\n\nMehrere gueltige Winkel verfuegbar. Bitte waehlen:")
+      (setq idx 1)
+      (foreach w gueltige-winkel
+        (setq eintrag (assoc w ergebnis-liste))
+        (princ (strcat "\n  " (itoa idx) " - " (itoa w) (chr 176)
+                       "   (L_GF=" (rtos (nth 1 eintrag) 2 1)
+                       " mm,  L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
+        (setq idx (1+ idx))
+      )
+      (setq wahl (getint (strcat "Winkel waehlen (1-"
+                                 (itoa (length gueltige-winkel)) ") [1]: ")))
+      (if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
+        (setq wahl 1))
+      (setq best-winkel (nth (1- wahl) gueltige-winkel))
+      (setq eintrag (assoc best-winkel ergebnis-liste))
+      (setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
+    )
+  )
+  (princ "\n\n=========================================")
+  (princ (strcat "\n>>> Winkel: " (itoa best-winkel) (chr 176)
+                 "   L_GF: " (rtos L_GF 2 2) " mm"
+                 "   L_VF: " (rtos L_VF 2 2) " mm"))
+  (princ "\n=========================================")
+
+  ;; 9. L_GF Verteilung
+  (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 (float staustrecke-basis))
+      (setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
+    ((= verteilung-modus "3")
+      (setq L_GF2 (float staustrecke-basis))
+      (setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
+    ((= 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 (max 0.0 (- L_GF L_GF1)))
+      (princ (strcat "\n  L_GF2 hinten: " (rtos L_GF2 2 2) " mm")))
+    (t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
+  )
+  (princ (strcat "\n>>> L_GF1=" (rtos L_GF1 2 2)
+                 " mm   L_GF2=" (rtos L_GF2 2 2) " mm"))
+
+  ;; 10. Anzahl Scanner
+  (setq n-scanner (getint "\nAnzahl Scanner [0]: "))
+  (if (null n-scanner) (setq n-scanner 0))
+
+  ;; 11. Bestaetigung
+  (princ "\n\nMoechten Sie die Foerderanlage einfuegen?")
+  (princ "\n  1 - Ja, Module einfuegen\n  2 - Nein, abbrechen")
+  (setq antwort (getstring "\nIhre Wahl (1/2): "))
+
+  (if (= antwort "1")
+    (progn
+      ;; Hoehenangaben fuer Attribute und Beschriftung
+      (setq hoehe-von (caddr startpunkt))
+      (setq hoehe-bis (cond
+        ((= richtung "Auf") (+ hoehe-von deltaH))
+        ((= richtung "Ab")  (- hoehe-von deltaH))
+        (t hoehe-von)))
+
+      ;; lastEnt VOR der Einfuegung merken
+      (setq lastEnt (entlast))
+      (if (and lastEnt
+               (= (cdr (assoc 0 (entget lastEnt))) "INSERT")
+               (= (cdr (assoc 66 (entget lastEnt))) 1))
+        (progn
+          (setq lastEnt (entnext lastEnt))
+          (while (and lastEnt
+                      (/= (cdr (assoc 0 (entget lastEnt))) "SEQEND"))
+            (setq lastEnt (entnext lastEnt))
+          )
+        )
+      )
+
+      ;; Typ-spezifische Einfuegung
+      (apply einfuege-fn
+        (list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite))
+
+      ;; Gemeinsame VF_*-Block-Erstellung
+      (vf-block-erstellen anlage-typ seite vf-nummer n-scanner
+                          hoehe-von hoehe-bis deltaH deltaL L_VF L_GF
+                          richtung best-winkel startpunkt lastEnt)
+
+      (princ "\n=========================================")
+    )
+    (princ "\nVorgang abgebrochen.")
+  )
+  nil
+)
+
+;; ============================================================
+;; START & ALIASES
+;; ============================================================
+(defun c:FOERDERANLAGE () (c:VarioFoerderer))
+
+(defun c:ETAGEVARIOFOERDERER ()
+  (setq *vf-vorauswahl-typ* "etage")
+  (c:VarioFoerderer)
+)
+
+;; ssg-ensure-Flags fuer beide Wrapper-Dateien setzen,
+;; damit ein zweiter Ladeaufruf uebersprungen wird.
+(setq *ssg-VarioFoerderer-loaded*      t)
+(setq *ssg-EtageVarioFoerderer-loaded* t)
+
+(princ "\n=========================================")
+(princ "\n>>> VF_CORE v26.0 geladen <<<")
+(princ "\n=========================================")
+(princ "\nBefehle:")
+(princ "\n  VarioFoerderer      - Foerderanlage erstellen (Typ-Auswahl)")
+(princ "\n  FOERDERANLAGE       - Alias fuer VarioFoerderer")
+(princ "\n  ETAGEVARIOFOERDERER - Etage-Foerderanlage direkt")
+(princ "\nRegistrierte Typen:")
+(foreach eintr *vf-typ-registry*
+  (princ (strcat "\n  " (car eintr) " - " (nth 3 eintr)))
+)
+(princ "\n=========================================")
+(princ)

Lisp/vf_etage.lsp

@@ -0,0 +1,784 @@
+;; ============================================================
+;; VF_ETAGE - Etage VarioFoerderer (Typ: "etage")
+;; Version: 26.0
+;; Abhaengigkeit: vf_core.lsp muss zuerst geladen sein
+;; Geometrie: AS/ES 30 Grad, direkt uebereinander (60 Grad Hz-Winkel)
+;; 15-Schritt-Einfuegung
+;; ============================================================
+
+;; Sicherstellen, dass vf_core.lsp geladen ist
+(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN"))))
+  (if (getenv "DXFM_LISP")
+    (load (strcat (getenv "DXFM_LISP") "/vf_core.lsp"))
+    (progn
+      (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.")
+      (exit)
+    )
+  )
+)
+
+;; ============================================================
+;; TEIL 1: ETAGE-SPEZIFISCHE GLOBALE VARIABLEN
+;; ============================================================
+(setq etage-aus-dx nil  etage-aus-dz nil)
+(setq etage-ein-dx nil  etage-ein-dz nil)
+(setq etage-gef-dx nil  etage-gef-dy nil  etage-gef-dz nil)
+(setq etage-gef-dx-rechts nil  etage-gef-dz-rechts nil)
+(setq etage-gef-dx-links  nil  etage-gef-dz-links  nil)
+(setq *etage-lib-initialized* nil)
+
+(setq FESTE_ETAGE_MITTE   1000)
+(setq ETAGE_SCHRAEG_LAENGE 700)
+(setq ETAGE_HZ_WINKEL       60)
+
+;; ============================================================
+;; TEIL 2: BIBLIOTHEK INITIALISIEREN (ETAGE-SPEZIFISCH)
+;; ============================================================
+(defun init-bibliothek-etage ( / temp-obj ks-data ks-ein-pos ks-aus-pos
+                                  gefaelle-blockname)
+  (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts")))
+    (setq *etage-lib-initialized* nil))
+  (if *etage-lib-initialized*
+    (progn (princ "\n  Etage-Bibliothek bereits initialisiert.") t)
+    (progn
+      (princ "\n  Initialisiere Etage-Bibliothek...")
+
+      ;; Standard-Bogen-Daten laden (bogen-auf/bogen-ab benoetigt)
+      (if (not *lib-initialized*)
+        (init-bibliothek)
+      )
+
+      ;; AS_30_rechts Masse extrahieren
+      (princ "\n  Extrahiere AS_30_rechts Masse...")
+      (ensure-block-loaded "_3D_AS_30_rechts")
+      (ensure-block-loaded "_3D_AS_30_links")
+      (if (tblsearch "BLOCK" "_3D_AS_30_rechts")
+        (progn
+          (setq temp-obj (vla-InsertBlock modelspace
+                           (vlax-3D-point '(0 0 0))
+                           "_3D_AS_30_rechts" 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 etage-aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
+              (setq etage-aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+              (princ (strcat "\n    AS_30_rechts: dx=" (rtos etage-aus-dx 2 1)
+                             " mm, dz=" (rtos etage-aus-dz 2 1) " mm"))
+            )
+            (progn
+              (princ "\n    WARNUNG: KS fehlt - Standardwerte")
+              (setq etage-aus-dx 525.8  etage-aus-dz -72.9)
+            )
+          )
+        )
+        (progn
+          (princ "\n    WARNUNG: Block _3D_AS_30_rechts fehlt - Standardwerte")
+          (setq etage-aus-dx 525.8  etage-aus-dz -72.9)
+        )
+      )
+
+      ;; ES_30_rechts Masse extrahieren
+      (princ "\n  Extrahiere ES_30_rechts Masse...")
+      (ensure-block-loaded "_3D_ES_30_rechts")
+      (ensure-block-loaded "_3D_ES_30_links")
+      (if (tblsearch "BLOCK" "_3D_ES_30_rechts")
+        (progn
+          (setq temp-obj (vla-InsertBlock modelspace
+                           (vlax-3D-point '(0 0 0))
+                           "_3D_ES_30_rechts" 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 etage-ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos)))
+              (setq etage-ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+              (princ (strcat "\n    ES_30_rechts: dx=" (rtos etage-ein-dx 2 1)
+                             " mm, dz=" (rtos etage-ein-dz 2 1) " mm"))
+            )
+            (progn
+              (princ "\n    WARNUNG: KS fehlt - Standardwerte")
+              (setq etage-ein-dx 576.2  etage-ein-dz -54.6)
+            )
+          )
+        )
+        (progn
+          (princ "\n    WARNUNG: Block _3D_ES_30_rechts fehlt - Standardwerte")
+          (setq etage-ein-dx 576.2  etage-ein-dz -54.6)
+        )
+      )
+
+      ;; Gefaellebogen_links_60 Masse extrahieren
+      (setq gefaelle-blockname
+        (strcat "Gefaellebogen_links_60" grad-zeichen "_R500"))
+      (princ (strcat "\n  Extrahiere " gefaelle-blockname " Masse..."))
+      (ensure-block-loaded gefaelle-blockname)
+      (if (tblsearch "BLOCK" gefaelle-blockname)
+        (progn
+          (setq temp-obj (vla-InsertBlock modelspace
+                           (vlax-3D-point '(0 0 0)) gefaelle-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 etage-gef-dx-links (- (caar  ks-aus-pos) (caar  ks-ein-pos)))
+              (setq etage-gef-dz-links (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+            )
+            (progn
+              (princ "\n    WARNUNG: kein KS - Standardwerte (links)")
+              (setq etage-gef-dx-links 0.0  etage-gef-dz-links -10.0)
+            )
+          )
+        )
+        (progn
+          (princ "\n    WARNUNG: Block fehlt - Standardwerte (links)")
+          (setq etage-gef-dx-links 0.0  etage-gef-dz-links -10.0)
+        )
+      )
+      (princ (strcat "\n    Gefaellebogen links: dx=" (rtos etage-gef-dx-links 2 2)
+                     " dz=" (rtos etage-gef-dz-links 2 2) " mm"))
+
+      ;; Gefaellebogen_rechts_60 Masse extrahieren
+      (setq gefaelle-blockname
+        (strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500"))
+      (princ (strcat "\n  Extrahiere " gefaelle-blockname " Masse..."))
+      (ensure-block-loaded gefaelle-blockname)
+      (if (tblsearch "BLOCK" gefaelle-blockname)
+        (progn
+          (setq temp-obj (vla-InsertBlock modelspace
+                           (vlax-3D-point '(0 0 0)) gefaelle-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 etage-gef-dx-rechts (- (caar  ks-aus-pos) (caar  ks-ein-pos)))
+              (setq etage-gef-dz-rechts (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+            )
+            (progn
+              (princ "\n    WARNUNG: kein KS - Standardwerte (rechts)")
+              (setq etage-gef-dx-rechts 0.0  etage-gef-dz-rechts -10.0)
+            )
+          )
+        )
+        (progn
+          (princ "\n    WARNUNG: Block fehlt - Standardwerte (rechts)")
+          (setq etage-gef-dx-rechts 0.0  etage-gef-dz-rechts -10.0)
+        )
+      )
+      (princ (strcat "\n    Gefaellebogen rechts: dx=" (rtos etage-gef-dx-rechts 2 2)
+                     " dz=" (rtos etage-gef-dz-rechts 2 2) " mm"))
+
+      (setq *etage-lib-initialized* t)
+      (princ "\n  Etage-Bibliothek erfolgreich initialisiert.")
+      t
+    )
+  )
+)
+
+;; ============================================================
+;; TEIL 3: EINFUEGEFUNKTIONEN MIT KOMBINIERTER HZ+VERT ROTATION
+;; ============================================================
+;; Transformationsmatrix: Rz(hz) * Ry(vert)
+;;   [ cos(hz)*cos(vert)  -sin(hz)  cos(hz)*sin(vert) ]
+;;   [ sin(hz)*cos(vert)   cos(hz)  sin(hz)*sin(vert) ]
+;;   [ -sin(vert)          0        cos(vert)          ]
+
+(defun insert-hz-incl-scaled-block (blockname startpunkt laenge hz-winkel vert-winkel /
+                                     rad-hz rad-vert chz shz cv sv scale
+                                     matrix block-obj endpunkt)
+  (setq scale    (/ (float laenge) 1000.0))
+  (setq rad-hz   (* (float hz-winkel)   (/ pi 180.0)))
+  (setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
+  (setq chz (cos rad-hz) shz (sin rad-hz))
+  (setq cv  (cos rad-vert) sv  (sin rad-vert))
+  (ensure-block-loaded blockname)
+  (if (not (tblsearch "BLOCK" blockname))
+    (progn
+      (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
+      (exit)
+    )
+  )
+  (setq block-obj (vla-InsertBlock modelspace
+                    (vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0))
+  (setq matrix (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-TransformBy block-obj (vlax-tmatrix matrix))
+  (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt))
+  (setq endpunkt (list
+    (+ (car startpunkt)   (* laenge chz cv))
+    (+ (cadr startpunkt)  (* laenge shz cv))
+    (+ (caddr startpunkt) (* (- sv) laenge))))
+  (princ (strcat "\n    HzIncl " blockname " L=" (rtos laenge 2 0)
+                 " hz=" (rtos hz-winkel 2 0) (chr 176)
+                 " v=" (rtos vert-winkel 2 0) (chr 176)
+                 " -> Z=" (rtos (caddr endpunkt) 2 1)))
+  endpunkt
+)
+
+(defun insert-hz-rotated-block-with-ks (blockname startpunkt hz-winkel vert-winkel block-dx block-dz /
+                                         rad-hz rad-vert chz shz cv sv
+                                         matrix block-obj endpunkt)
+  (setq rad-hz   (* (float hz-winkel)   (/ pi 180.0)))
+  (setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
+  (setq chz (cos rad-hz) shz (sin rad-hz))
+  (setq cv  (cos rad-vert) sv  (sin rad-vert))
+  (ensure-block-loaded blockname)
+  (if (not (tblsearch "BLOCK" blockname))
+    (progn
+      (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
+      (exit)
+    )
+  )
+  (setq block-obj (vla-InsertBlock modelspace
+                    (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
+  (setq matrix (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-TransformBy block-obj (vlax-tmatrix matrix))
+  (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt))
+  (setq endpunkt (list
+    (+ (car startpunkt)   (+ (* block-dx chz cv) (* block-dz chz sv)))
+    (+ (cadr startpunkt)  (+ (* block-dx shz cv) (* block-dz shz sv)))
+    (+ (caddr startpunkt) (+ (* (- sv) block-dx) (* cv block-dz)))))
+  (princ (strcat "\n    HzRot " blockname
+                 " hz=" (rtos hz-winkel 2 0) (chr 176)
+                 " v=" (rtos vert-winkel 2 0) (chr 176)
+                 " -> Z=" (rtos (caddr endpunkt) 2 1)))
+  endpunkt
+)
+
+(defun insert-hz-rotated-block-by-ks (blockname startpunkt hz-winkel vert-winkel /
+                                        rad-hz rad-vert chz shz cv sv
+                                        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 "' nicht in Bibliothek - abgebrochen"))
+      (exit)
+    )
+  )
+  (setq rad-hz   (* (float hz-winkel)   (/ pi 180.0)))
+  (setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
+  (setq chz (cos rad-hz) shz (sin rad-hz))
+  (setq cv  (cos rad-vert) sv  (sin rad-vert))
+  ;; KS-Positionen aus Cache (Block bei 0 Grad 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 rotieren
+  (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))))
+  (if (and ks-ein ks-aus)
+    (progn
+      (setq p-ein (car ks-ein))
+      (setq p-aus (car ks-aus))
+      ;; Rotation auf KS-Punkte anwenden: p' = Rz(hz)*Ry(vert) * p
+      (setq p-ein-rot
+        (list (+ (* chz cv (car p-ein)) (- (* shz (cadr p-ein))) (* chz sv (caddr p-ein)))
+              (+ (* shz cv (car p-ein)) (*  chz (cadr p-ein))    (* shz sv (caddr p-ein)))
+              (+    (* (- sv) (car p-ein))                        (* cv (caddr p-ein)))))
+      (setq p-aus-rot
+        (list (+ (* chz cv (car p-aus)) (- (* shz (cadr p-aus))) (* chz sv (caddr p-aus)))
+              (+ (* shz cv (car p-aus)) (*  chz (cadr p-aus))    (* shz sv (caddr p-aus)))
+              (+    (* (- sv) (car p-aus))                        (* cv (caddr p-aus)))))
+      ;; Block verschieben: rotiertes KS_EIN auf startpunkt
+      (vla-Move block-obj
+        (vlax-3D-point p-ein-rot)
+        (vlax-3D-point startpunkt))
+      (setq offset (list (- (car startpunkt)   (car p-ein-rot))
+                         (- (cadr startpunkt)  (cadr p-ein-rot))
+                         (- (caddr startpunkt) (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    HzRotKS " blockname
+                     " hz=" (rtos hz-winkel 2 0) (chr 176)
+                     " -> Z=" (rtos (caddr ausgang) 2 1)))
+      ausgang
+    )
+    (progn
+      (princ (strcat "\n  WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt"))
+      startpunkt
+    )
+  )
+)
+
+(defun insert-hz-scaled-block-by-ks (blockname startpunkt laenge hz-winkel vert-winkel /
+                                       rad-hz rad-vert chz shz cv sv scale
+                                       temp-obj block-obj ks-data ks-ein ks-aus
+                                       p-ein p-aus p-ein-s p-aus-s
+                                       p-ein-rot p-aus-rot offset ausgang)
+  (ensure-block-loaded blockname)
+  (if (not (tblsearch "BLOCK" blockname))
+    (progn
+      (princ (strcat "\n  FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen"))
+      (exit)
+    )
+  )
+  (setq scale (/ (float laenge) 1000.0))
+  (setq rad-hz   (* (float hz-winkel)   (/ pi 180.0)))
+  (setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
+  (setq chz (cos rad-hz) shz (sin rad-hz))
+  (setq cv  (cos rad-vert) sv  (sin rad-vert))
+  ;; KS bei Massstab 1
+  (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 mit XScale einfuegen und rotieren
+  (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))))
+  (if (and ks-ein ks-aus)
+    (progn
+      (setq p-ein (car ks-ein))
+      (setq p-aus (car ks-aus))
+      ;; X-Skalierung anwenden
+      (setq p-ein-s (list (* scale (car p-ein)) (cadr p-ein) (caddr p-ein)))
+      (setq p-aus-s (list (* scale (car p-aus)) (cadr p-aus) (caddr p-aus)))
+      ;; Rotation: p' = Rz(hz)*Ry(vert) * p
+      (setq p-ein-rot
+        (list (+ (* chz cv (car p-ein-s)) (- (* shz (cadr p-ein-s))) (* chz sv (caddr p-ein-s)))
+              (+ (* shz cv (car p-ein-s)) (*  chz (cadr p-ein-s))    (* shz sv (caddr p-ein-s)))
+              (+    (* (- sv) (car p-ein-s))                           (* cv (caddr p-ein-s)))))
+      (setq p-aus-rot
+        (list (+ (* chz cv (car p-aus-s)) (- (* shz (cadr p-aus-s))) (* chz sv (caddr p-aus-s)))
+              (+ (* shz cv (car p-aus-s)) (*  chz (cadr p-aus-s))    (* shz sv (caddr p-aus-s)))
+              (+    (* (- sv) (car p-aus-s))                           (* cv (caddr p-aus-s)))))
+      ;; Block verschieben
+      (vla-Move block-obj
+        (vlax-3D-point p-ein-rot)
+        (vlax-3D-point startpunkt))
+      (setq offset (list (- (car startpunkt)   (car p-ein-rot))
+                         (- (cadr startpunkt)  (cadr p-ein-rot))
+                         (- (caddr startpunkt) (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    HzScaleKS " blockname
+                     " " (rtos laenge 2 0) "mm"
+                     " hz=" (rtos hz-winkel 2 0) (chr 176)
+                     " -> Z=" (rtos (caddr ausgang) 2 1)))
+      ausgang
+    )
+    (progn
+      (princ (strcat "\n  WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt"))
+      startpunkt
+    )
+  )
+)
+
+;; ============================================================
+;; TEIL 4: WINKELBERECHNUNG (ETAGE)
+;; ============================================================
+(defun berechne-winkel-etage (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 abs-dz-GEF
+                               L_GF L_VF cosα sinα
+                               winkel-eff cosEff sinEff rad5 rad7
+                               winkel mass1 mass2 gueltig
+                               best-winkel best-L_GF best-L_VF
+                               feste-gesamt-cos feste-gesamt-sin
+                               schraeg-hz-rad schraeg-cos schraeg-z)
+
+  (if (not *etage-lib-initialized*)
+    (progn
+      (alert "Etage-Bibliothek nicht initialisiert!")
+      (exit)
+    )
+  )
+
+  (setq abs-dz-AUS (abs etage-aus-dz)
+        abs-dz-EIN (abs etage-ein-dz)
+        abs-dz-GEF (abs etage-gef-dz))
+
+  (setq winkel-list '(3 6 9 12 15 18 21 27 33 39 45 51))
+  (setq ergebnis-liste '())
+  (setq cos3 (cos (* 3.0 (/ pi 180.0)))
+        sin3 (sin (* 3.0 (/ pi 180.0))))
+
+  (setq feste-gesamt-cos (* FESTE_ETAGE_MITTE cos3))
+  (setq feste-gesamt-sin (* FESTE_ETAGE_MITTE sin3))
+  (setq schraeg-hz-rad (* (float ETAGE_HZ_WINKEL) (/ pi 180.0)))
+  (setq schraeg-cos  (* (cos schraeg-hz-rad) cos3))
+
+  (princ "\n\n=========================================")
+  (princ "\n  ETAGE-BERECHNUNG FUER ALLE WINKEL")
+  (princ "\n=========================================")
+  (princ (strcat "\n△L=" (rtos deltaL 2 2) " mm"
+                 "  △H=" (rtos deltaH 2 2) " mm"
+                 "  Richtung=" richtung))
+
+  (foreach winkel winkel-list
+    (if (= richtung "Auf")
+      (progn
+        (setq mass1 (get-bogen-mass bogen-auf winkel))
+        (setq mass2 (get-bogen-mass bogen-ab  winkel))
+      )
+      (progn
+        (setq mass1 (get-bogen-mass bogen-ab  winkel))
+        (setq mass2 (get-bogen-mass bogen-auf winkel))
+      )
+    )
+    (if (or (null mass1) (null mass2))
+      (progn
+        (princ (strcat "\n  " (itoa winkel) (chr 176) " -> Bogen nicht vorhanden"))
+        (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
+      )
+      (progn
+        (setq rad5 (* 3.0 (/ pi 180.0)))
+        (setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3)))
+                      (/ pi 180.0)))
+        (setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5))))
+        (setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5))))
+        (setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7))))
+        (setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7))))
+        (setq cosα (cos (* winkel (/ pi 180.0)))
+              sinα (sin (* winkel (/ pi 180.0))))
+        (setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3)))
+        (setq cosEff (cos (* winkel-eff (/ pi 180.0)))
+              sinEff (sin (* winkel-eff (/ pi 180.0))))
+        ;; A: horizontaler Rest nach Abzug aller festen Teile
+        (setq A (- deltaL
+                   etage-aus-dx
+                   etage-ein-dx
+                   (* 2.0 ETAGE_SCHRAEG_LAENGE schraeg-cos)
+                   (* 2.0 etage-gef-dx)
+                   bogen-x1
+                   bogen-x2
+                   (* 2.0 feste-gesamt-cos)))
+        ;; B: vertikaler Rest (Vorzeichen analog Standard)
+        (setq schraeg-z (* ETAGE_SCHRAEG_LAENGE sin3))
+        (if (= richtung "Auf")
+          (setq B (+ deltaH
+                     abs-dz-AUS
+                     abs-dz-EIN
+                     (* 2.0 schraeg-z)
+                     (* 2.0 abs-dz-GEF)
+                     (- bogen-z1)
+                     (- bogen-z2)
+                     (* 2.0 feste-gesamt-sin)))
+          (setq B (+ (- deltaH
+                        abs-dz-AUS
+                        abs-dz-EIN
+                        (* 2.0 schraeg-z)
+                        (* 2.0 abs-dz-GEF)
+                        (* 2.0 feste-gesamt-sin))
+                     bogen-z1
+                     bogen-z2))
+        )
+        (if (> (abs sinα) 0.0001)
+          (progn
+            (setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα))
+            (if (= richtung "Auf")
+              (setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα))
+              (setq L_VF (/ (- (* B cos3) (* A sin3)) sinα))
+            )
+            (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))
+
+  (princ "\n\n=================================================================================")
+  (princ "\n  ERGEBNISTABELLE  (L_GF = gesamt beider GF-Strecken)")
+  (princ "\n=================================================================================")
+  (princ "\n  Winkel     L_GF (mm)        L_VF (mm)        Status")
+  (princ "\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) (chr 176)
+                       "       " (fmt L_GF) " mm     " (fmt L_VF) " mm     "))
+        (if gueltig
+          (progn
+            (princ "GUELTIG")
+            (if (or (null best-winkel) (< winkel best-winkel))
+              (setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
+            )
+          )
+          (princ "UNGUELTIG (negative Laenge)")
+        )
+      )
+      (princ (strcat "\n  " (itoa winkel) (chr 176)
+                     "       ---              ---              FEHLER"))
+    )
+  )
+  (princ "\n=================================================================================")
+  (if best-winkel
+    (princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176)))
+    (princ "\n>>> KEIN passender Winkel gefunden!")
+  )
+  (list best-winkel best-L_GF best-L_VF ergebnis-liste)
+)
+
+;; ============================================================
+;; TEIL 5: BERECHNE-WRAPPER (Schnittstelle fuer Registry)
+;; ============================================================
+;; Initialisiert Etage-Bibliothek, aktiviert Gefaellebogen-Masse
+;; passend zur gewaehlten Seite (benoetigt fuer Geometrieberechnung).
+(defun berechne-etage (deltaL deltaH richtung seite)
+  (init-bibliothek-etage)
+  (if (= seite "rechts")
+    (progn
+      (setq etage-gef-dx etage-gef-dx-rechts)
+      (setq etage-gef-dz etage-gef-dz-rechts))
+    (progn
+      (setq etage-gef-dx etage-gef-dx-links)
+      (setq etage-gef-dz etage-gef-dz-links))
+  )
+  (princ (strcat "\n  Gefaellebogen " seite
+                 ": dx=" (rtos etage-gef-dx 2 2) " mm"))
+  (berechne-winkel-etage deltaL deltaH richtung)
+)
+
+;; ============================================================
+;; TEIL 6: EINFUEGEN (15 Schritte, ohne VF_*-Block-Erstellung)
+;; ============================================================
+;; Gibt endpunkt zurueck.
+;; VF_*-Block-Erstellung erfolgt zentral im Dispatcher (vf_core.lsp).
+(defun etage-foerderanlage-einfuegen (deltaL deltaH richtung
+                                       best-winkel L_GF1 L_GF2 L_VF
+                                       startpunkt seite
+                                       / aktueller-punkt bogen-name endpunkt
+                                         bogen-mass bogen-dx bogen-dz
+                                         as-block es-block gefaelle-blockname
+                                         hz-vorzeichen hz-anfang hz-ende)
+  (setq aktueller-punkt startpunkt)
+  ;; Horizontalwinkel-Vorzeichen je nach Seite:
+  ;;   rechts: Anfang +60 Grad (links), Ende -60 Grad (rechts)
+  ;;   links:  Anfang -60 Grad, Ende +60 Grad
+  (setq hz-vorzeichen (if (= seite "rechts") 1 -1))
+  (setq hz-anfang (*  hz-vorzeichen ETAGE_HZ_WINKEL))
+  (setq hz-ende   (* (- hz-vorzeichen) ETAGE_HZ_WINKEL))
+  (setq as-block (strcat "_3D_AS_30_" seite))
+  (setq es-block (strcat "_3D_ES_30_" seite))
+  (setq gefaelle-blockname
+    (if (= seite "rechts")
+      (strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500")
+      (strcat "Gefaellebogen_links_60" grad-zeichen "_R500")
+    ))
+  ;; Sentinel: Bibliothek neu initialisieren wenn Bloecke fehlen
+  (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts")))
+    (setq *etage-lib-initialized* nil))
+  (if (not *etage-lib-initialized*) (init-bibliothek-etage))
+
+  ;; 1. AS_30
+  (princ (strcat "\n\n1/15: " as-block " (0 Grad)"))
+  (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt))
+
+  ;; 2. Staustrecke 400mm (hz-anfang, 3 Grad vert, KS_EIN)
+  (princ (strcat "\n\n2/15: Staustrecke 400mm ("
+                 (itoa hz-anfang) " Grad hz, 3 Grad vert, KS_EIN)"))
+  (setq aktueller-punkt
+    (insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
+      400 hz-anfang 3))
+
+  ;; 3. Separator (hz-anfang, 3 Grad vert)
+  (princ (strcat "\n\n3/15: Separator (300mm, "
+                 (itoa hz-anfang) " Grad hz, 3 Grad vert)"))
+  (setq aktueller-punkt
+    (insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
+      hz-anfang 3 300 0))
+
+  ;; 4. Gefaellebogen Anfang (hz-anfang, 0 Grad vert, KS_EIN)
+  (princ (strcat "\n\n4/15: " gefaelle-blockname
+                 " (Anfang, " (itoa hz-anfang) " Grad hz, 0 Grad vert, KS_EIN)"))
+  (setq aktueller-punkt
+    (insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt hz-anfang 0))
+
+  ;; 5. L_GF1 (3 Grad geneigt)
+  (if (> L_GF1 0.1)
+    (progn
+      (princ (strcat "\n\n5/15: Gefaellestrecke (3 Grad, L=" (rtos L_GF1 2 2) " mm)"))
+      (setq aktueller-punkt
+        (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3))
+    )
+    (princ "\n\n5/15: L_GF1 (uebersprungen)")
+  )
+
+  ;; 6. Umlenkstation (3 Grad geneigt)
+  (princ "\n\n6/15: Umlenkstation (500mm, 3 Grad geneigt)")
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3 500 0))
+
+  ;; 7. 1. Vertikalbogen (3 Grad geneigt)
+  (if (= richtung "Auf")
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
+    )
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
+    )
+  )
+  (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
+  (princ (strcat "\n\n7/15: " bogen-name " (3 Grad geneigt)"))
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz))
+
+  ;; 8. Variable Strecke L_VF
+  (if (> L_VF 0.1)
+    (progn
+      (if (= richtung "Auf")
+        (progn
+          (princ (strcat "\n\n8/15: Steigungsstrecke ("
+                         (itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)"))
+          (setq aktueller-punkt
+            (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
+              L_VF (- (- best-winkel 3))))
+        )
+        (progn
+          (princ (strcat "\n\n8/15: Gefaellestrecke ("
+                         (itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)"))
+          (setq aktueller-punkt
+            (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
+              L_VF (+ best-winkel 3)))
+        )
+      )
+    )
+    (princ "\n\n8/15: L_VF (uebersprungen)")
+  )
+
+  ;; 9. 2. Vertikalbogen
+  (if (= richtung "Auf")
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
+    )
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
+    )
+  )
+  (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
+  (if (= richtung "Auf")
+    (progn
+      (princ (strcat "\n\n9/15: " bogen-name
+                     " (" (itoa (- 3 best-winkel)) " Grad geneigt)"))
+      (setq aktueller-punkt
+        (insert-rotated-block-with-ks bogen-name aktueller-punkt
+          (- 3 best-winkel) bogen-dx bogen-dz))
+    )
+    (progn
+      (princ (strcat "\n\n9/15: " bogen-name
+                     " (" (itoa (+ best-winkel 3)) " Grad geneigt)"))
+      (setq aktueller-punkt
+        (insert-rotated-block-with-ks bogen-name aktueller-punkt
+          (+ best-winkel 3) bogen-dx bogen-dz))
+    )
+  )
+
+  ;; 10. Motorstation (3 Grad geneigt)
+  (princ "\n\n10/15: Motorstation (500mm, 3 Grad geneigt)")
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 3 500 0))
+
+  ;; 11. L_GF2 (3 Grad geneigt)
+  (if (> L_GF2 0.1)
+    (progn
+      (princ (strcat "\n\n11/15: Gefaellestrecke (3 Grad, L=" (rtos L_GF2 2 2) " mm)"))
+      (setq aktueller-punkt
+        (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF2 3))
+    )
+    (princ "\n\n11/15: L_GF2 (uebersprungen)")
+  )
+
+  ;; 12. Gefaellebogen Ende (via KS_EIN, 0 Grad vert)
+  (princ (strcat "\n\n12/15: " gefaelle-blockname " (Ende, KS_EIN)"))
+  (setq aktueller-punkt (insert-block-by-ks gefaelle-blockname aktueller-punkt))
+
+  ;; 13. Separator Ende (hz-ende, 3 Grad vert)
+  (princ (strcat "\n\n13/15: Separator (300mm, "
+                 (itoa hz-ende) " Grad hz, 3 Grad vert)"))
+  (setq aktueller-punkt
+    (insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
+      hz-ende 3 300 0))
+
+  ;; 14. Staustrecke 400mm Ende (hz-ende, 3 Grad vert, KS_EIN)
+  (princ (strcat "\n\n14/15: Staustrecke 400mm ("
+                 (itoa hz-ende) " Grad hz, 3 Grad vert, KS_EIN)"))
+  (setq aktueller-punkt
+    (insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
+      400 hz-ende 3))
+
+  ;; 15. ES_30 (hz-ende, 0 Grad vert)
+  (princ (strcat "\n\n15/15: " es-block
+                 " (Ende, " (itoa hz-ende) " Grad hz, 0 Grad vert)"))
+  (setq endpunkt
+    (insert-hz-rotated-block-with-ks es-block aktueller-punkt
+      hz-ende 0 etage-ein-dx etage-ein-dz))
+
+  (princ "\n\n=========================================")
+  (princ "\n>>> Etage-VarioFoerderer eingefuegt! <<<")
+  endpunkt
+)
+
+;; ============================================================
+;; REGISTRIERUNG
+;; ============================================================
+(vf-typ-registrieren
+  "etage"
+  'berechne-etage
+  'etage-foerderanlage-einfuegen
+  "Etage VarioFoerderer (AS/ES 30 Grad, direkt uebereinander)")
+
+(princ "\n>>> vf_etage.lsp geladen - Typ 'etage' registriert")
+(princ)

Lisp/vf_standard.lsp

@@ -0,0 +1,499 @@
+;; ============================================================
+;; VF_STANDARD - Standard VarioFoerderer (Typ: "standard")
+;; Version: 26.0
+;; Abhaengigkeit: vf_core.lsp muss zuerst geladen sein
+;; Geometrie: AS/ES 90 Grad, horizontal versetzt
+;; 11-Schritt-Einfuegung
+;; ============================================================
+
+;; Sicherstellen, dass vf_core.lsp geladen ist
+(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN"))))
+  (if (getenv "DXFM_LISP")
+    (load (strcat (getenv "DXFM_LISP") "/vf_core.lsp"))
+    (progn
+      (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.")
+      (exit)
+    )
+  )
+)
+
+;; ============================================================
+;; TEIL 1: STANDARD-SPEZIFISCHE GLOBALE VARIABLEN
+;; ============================================================
+(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)
+
+(setq bogen-auf '())
+(setq bogen-ab  '())
+
+(setq *lib-initialized*    nil)
+(setq *bogen-cache-loaded* nil)
+(setq *modul-cache*        nil)
+
+;; ============================================================
+;; TEIL 2: BIBLIOTHEK INITIALISIEREN
+;; ============================================================
+(defun init-bibliothek ( / temp-obj bogen-winkel ks-data ks-ein-pos ks-aus-pos
+                           dx dy dz bogen-name)
+  (if (and *lib-initialized* (tblsearch "BLOCK" "_3D_AS_90_links"))
+    (progn
+      (princ "\n  Standard-Bibliothek bereits initialisiert.")
+      t
+    )
+    (progn
+      (setq *lib-initialized* nil)
+      (setq *ks-cache* nil)
+      (princ "\n  Initialisiere Standard-Bibliothek...")
+
+      ;; AS_90 Masse extrahieren
+      (princ "\n  Extrahiere AUS_Element Masse...")
+      (ensure-block-loaded "_3D_AS_90_links")
+      (ensure-block-loaded "_3D_AS_90_rechts")
+      (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 (- (caar ks-aus-pos) (caar ks-ein-pos)))
+              (setq aus-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
+              (setq aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+              (princ (strcat "\n    AS_90: dx=" (rtos aus-dx 2 0)
+                             " dz=" (rtos aus-dz 2 0)))
+            )
+            (princ "\n    FEHLER: KS_EIN/KS_AUS fehlt im AS_90!")
+          )
+        )
+        (princ "\n    FEHLER: Block _3D_AS_90_links nicht geladen!")
+      )
+
+      ;; ES_90 Masse extrahieren
+      (princ "\n  Extrahiere EIN_Element Masse...")
+      (ensure-block-loaded "_3D_ES_90_links")
+      (ensure-block-loaded "_3D_ES_90_rechts")
+      (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 (- (caar ks-aus-pos) (caar ks-ein-pos)))
+              (setq ein-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
+              (setq ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+              (princ (strcat "\n    ES_90: dx=" (rtos ein-dx 2 0)
+                             " dz=" (rtos ein-dz 2 0)))
+            )
+            (princ "\n    FEHLER: KS_EIN/KS_AUS fehlt im ES_90!")
+          )
+        )
+        (princ "\n    FEHLER: Block _3D_ES_90_links nicht geladen!")
+      )
+
+      ;; Bogen-Masse extrahieren
+      (princ "\n  Extrahiere Bogen-Masse...")
+      (setq bogen-auf '())
+      (setq bogen-ab  '())
+      (setq bogen-winkel (ssg-cfg-or "vario" "bogen_winkel"
+                           '(3 6 9 12 15 18 21 27 33 39 45 51)))
+      (foreach w bogen-winkel
+        ;; Aufwaertsbogen
+        (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) grad-zeichen))
+        (ensure-block-loaded bogen-name)
+        (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)
+            (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 dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
+                (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+                (setq bogen-auf (cons (list w dx dy dz) bogen-auf))
+                (princ (strcat "\n    OK auf_" (itoa w)
+                               ": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
+              )
+              (princ (strcat "\n    FEHLER auf_" (itoa w) ": KS fehlt!"))
+            )
+          )
+          (princ (strcat "\n    FEHLER auf_" (itoa w) ": Block nicht geladen!"))
+        )
+        ;; Abwaertsbogen
+        (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) grad-zeichen))
+        (ensure-block-loaded bogen-name)
+        (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)
+            (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 dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos))))
+                (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos))))
+                (setq bogen-ab (cons (list w dx dy dz) bogen-ab))
+                (princ (strcat "\n    OK ab_" (itoa w)
+                               ": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
+              )
+              (princ (strcat "\n    FEHLER ab_" (itoa w) ": KS fehlt!"))
+            )
+          )
+          (princ (strcat "\n    FEHLER ab_" (itoa w) ": Block nicht geladen!"))
+        )
+      )
+      (setq bogen-auf (reverse bogen-auf))
+      (setq bogen-ab  (reverse bogen-ab))
+      (setq *lib-initialized* t)
+      (princ "\n  Standard-Bibliothek erfolgreich initialisiert.")
+      t
+    )
+  )
+)
+
+;; ============================================================
+;; TEIL 3: BOGEN-MASSE
+;; ============================================================
+(defun get-bogen-mass (tabelle winkel)
+  (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!"))
+  )
+  result
+)
+
+;; ============================================================
+;; TEIL 4: WINKELBERECHNUNG
+;; ============================================================
+(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α
+                             winkel-eff cosEff sinEff rad5 rad7
+                             winkel mass1 mass2 gueltig
+                             best-winkel best-L_GF best-L_VF)
+
+  (if (not *lib-initialized*)
+    (progn
+      (alert "Bibliothek nicht initialisiert!")
+      (exit)
+    )
+  )
+
+  (setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz))
+  (setq winkel-list (ssg-cfg-or "vario" "bogen_winkel"
+                     '(3 6 9 12 15 18 21 27 33 39 45 51)))
+  (setq ergebnis-liste '())
+  (setq cos3 (cos (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0)))
+        sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))))
+
+  (princ "\n\n=========================================")
+  (princ "\n  BERECHNUNG FUER ALLE WINKEL (Standard)")
+  (princ "\n=========================================")
+  (princ (strcat "\n△L=" (rtos deltaL 2 2) " mm"
+                 "  △H=" (rtos deltaH 2 2) " mm"
+                 "  Richtung=" richtung))
+
+  (foreach winkel winkel-list
+    (if (= richtung "Auf")
+      (progn
+        (setq mass1 (get-bogen-mass bogen-auf winkel))
+        (setq mass2 (get-bogen-mass bogen-ab  winkel))
+      )
+      (progn
+        (setq mass1 (get-bogen-mass bogen-ab  winkel))
+        (setq mass2 (get-bogen-mass bogen-auf winkel))
+      )
+    )
+    (if (or (null mass1) (null mass2))
+      (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
+      (progn
+        (setq rad5 (* 3.0 (/ pi 180.0)))
+        (setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3)))
+                      (/ pi 180.0)))
+        (setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5))))
+        (setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5))))
+        (setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7))))
+        (setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7))))
+        (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)))
+        (setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3)))
+        (setq cosEff (cos (* winkel-eff (/ pi 180.0)))
+              sinEff (sin (* winkel-eff (/ pi 180.0))))
+        (if (= richtung "Auf")
+          (setq B (+ deltaH abs-dz-AUS abs-dz-EIN
+                     (- bogen-z1) (- bogen-z2)
+                     (* FESTE_HORIZONTAL sin3)))
+          (setq B (+ (- deltaH abs-dz-AUS abs-dz-EIN
+                         (* FESTE_HORIZONTAL sin3))
+                     bogen-z1 bogen-z2))
+        )
+        (if (> (abs sinα) 0.0001)
+          (progn
+            (setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα))
+            (if (= richtung "Auf")
+              (setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα))
+              (setq L_VF (/ (- (* B cos3) (* A sin3)) sinα))
+            )
+            (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))
+
+  (princ "\n\n=================================================================================")
+  (princ "\n  ERGEBNISTABELLE")
+  (princ "\n=================================================================================")
+  (princ "\n  Winkel     L_GF (mm)        L_VF (mm)        Status")
+  (princ "\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) (chr 176)
+                       "       " (fmt L_GF) " mm     " (fmt L_VF) " mm     "))
+        (if gueltig
+          (progn
+            (princ "GUELTIG")
+            (if (or (null best-winkel) (< winkel best-winkel))
+              (setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
+            )
+          )
+          (princ "UNGUELTIG (negative Laenge)")
+        )
+      )
+      (princ (strcat "\n  " (itoa winkel) (chr 176)
+                     "       ---              ---              FEHLER"))
+    )
+  )
+  (princ "\n=================================================================================")
+  (if best-winkel
+    (princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176)))
+    (princ "\n>>> KEIN passender Winkel gefunden!")
+  )
+  (list best-winkel best-L_GF best-L_VF ergebnis-liste)
+)
+
+;; ============================================================
+;; TEIL 5: BERECHNE-WRAPPER (Schnittstelle fuer Registry)
+;; ============================================================
+;; Initialisiert Standard-Bibliothek und berechnet Winkel.
+;; seite-Parameter wird fuer Standard-Typ nicht benoetigt (keine Vorab-Geometrie).
+(defun berechne-standard (deltaL deltaH richtung seite)
+  (setq FESTE_HORIZONTAL  (ssg-cfg-or "vario" "feste_horizontal"  1600))
+  (setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
+  (init-bibliothek)
+  (berechne-alle-winkel deltaL deltaH richtung)
+)
+
+;; ============================================================
+;; TEIL 6: EINFUEGEN (11 Schritte, ohne VF_*-Block-Erstellung)
+;; ============================================================
+;; Gibt endpunkt zurueck (letzter KS_AUS nach ES_90).
+;; VF_*-Block-Erstellung erfolgt zentral im Dispatcher (vf_core.lsp).
+(defun variofoerderer-einfuegen (deltaL deltaH richtung best-winkel
+                                  L_GF1 L_GF2 L_VF startpunkt seite
+                                / aktueller-punkt bogen-name endpunkt
+                                  bogen-mass bogen-dx bogen-dz
+                                  as-block es-block)
+  (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))
+
+  ;; 1. AUS_Element
+  (princ (strcat "\n\n1/11: " as-block " (0 Grad)"))
+  (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt))
+
+  ;; 2. 1. Gefaellestrecke
+  (if (> L_GF1 0.1)
+    (progn
+      (princ (strcat "\n\n2/11: Gefaellestrecke (3 Grad, L=" (rtos L_GF1 2 2) " mm)"))
+      (setq aktueller-punkt
+        (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
+          L_GF1 (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
+    )
+    (princ "\n\n2/11: (uebersprungen)")
+  )
+
+  ;; 3. Separator
+  (princ "\n\n3/11: Separator (300 mm, 3 Grad geneigt)")
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
+      (ssg-cfg-or "vario" "gefaelle_winkel" 3)
+      (ssg-cfg-or "vario" "separator_block_dx" 300)
+      (ssg-cfg-or "vario" "separator_block_dz" 0)))
+
+  ;; 4. Umlenkstation
+  (princ "\n\n4/11: Umlenkstation (500 mm, 3 Grad geneigt)")
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt
+      (ssg-cfg-or "vario" "gefaelle_winkel" 3)
+      (ssg-cfg-or "vario" "station_block_dx" 500)
+      (ssg-cfg-or "vario" "station_block_dz" 0)))
+
+  ;; 5. 1. Vertikalbogen
+  (if (= richtung "Auf")
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
+    )
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
+    )
+  )
+  (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
+  (princ (strcat "\n\n5/11: " bogen-name " (3 Grad geneigt)"))
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks bogen-name aktueller-punkt
+      (ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz))
+
+  ;; 6. Variable Strecke L_VF
+  (if (> L_VF 0.1)
+    (progn
+      (if (= richtung "Auf")
+        (progn
+          (princ (strcat "\n\n6/11: Steigungsstrecke ("
+                         (itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)"))
+          (setq aktueller-punkt
+            (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
+              L_VF (- (- best-winkel 3))))
+        )
+        (progn
+          (princ (strcat "\n\n6/11: Gefaellestrecke ("
+                         (itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)"))
+          (setq aktueller-punkt
+            (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
+              L_VF (+ best-winkel 3)))
+        )
+      )
+    )
+    (princ "\n\n6/11: (uebersprungen)")
+  )
+
+  ;; 7. 2. Vertikalbogen
+  (if (= richtung "Auf")
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
+    )
+    (progn
+      (setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
+      (setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
+    )
+  )
+  (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
+  (if (= richtung "Auf")
+    (progn
+      (princ (strcat "\n\n7/11: " bogen-name
+                     " (" (itoa (- 3 best-winkel)) " Grad geneigt)"))
+      (setq aktueller-punkt
+        (insert-rotated-block-with-ks bogen-name aktueller-punkt
+          (- 3 best-winkel) bogen-dx bogen-dz))
+    )
+    (progn
+      (princ (strcat "\n\n7/11: " bogen-name
+                     " (" (itoa (+ best-winkel 3)) " Grad geneigt)"))
+      (setq aktueller-punkt
+        (insert-rotated-block-with-ks bogen-name aktueller-punkt
+          (+ best-winkel 3) bogen-dx bogen-dz))
+    )
+  )
+
+  ;; 8. Motorstation
+  (princ "\n\n8/11: Motorstation (500 mm, 3 Grad geneigt)")
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt
+      (ssg-cfg-or "vario" "gefaelle_winkel" 3)
+      (ssg-cfg-or "vario" "station_block_dx" 500)
+      (ssg-cfg-or "vario" "station_block_dz" 0)))
+
+  ;; 9. 2. Gefaellestrecke
+  (if (> L_GF2 0.1)
+    (progn
+      (princ (strcat "\n\n9/11: Gefaellestrecke (3 Grad, L=" (rtos L_GF2 2 2) " mm)"))
+      (setq aktueller-punkt
+        (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
+          L_GF2 (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
+    )
+    (princ "\n\n9/11: (uebersprungen)")
+  )
+
+  ;; 10. Separator 2
+  (princ "\n\n10/11: Separator (300 mm, 3 Grad geneigt)")
+  (setq aktueller-punkt
+    (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
+      (ssg-cfg-or "vario" "gefaelle_winkel" 3)
+      (ssg-cfg-or "vario" "separator_block_dx" 300)
+      (ssg-cfg-or "vario" "separator_block_dz" 0)))
+
+  ;; 11. EIN_Element
+  (princ (strcat "\n\n11/11: " es-block " (0 Grad)"))
+  (setq endpunkt (insert-block-by-ks es-block aktueller-punkt))
+
+  (princ "\n\n=========================================")
+  (princ "\n>>> Standard VarioFoerderer eingefuegt!")
+  endpunkt
+)
+
+;; ============================================================
+;; REGISTRIERUNG
+;; ============================================================
+(vf-typ-registrieren
+  "standard"
+  'berechne-standard
+  'variofoerderer-einfuegen
+  "Standard VarioFoerderer (AS/ES 90 Grad, horizontal versetzt)")
+
+(princ "\n>>> vf_standard.lsp geladen - Typ 'standard' registriert")
+(princ)

menu/SSG_LIB.mnl

@@ -6,10 +6,34 @@
 ;; Feature-Module werden erst bei Menueklick nachgeladen.
 ;; ============================================================
 
-;; Globale Variable: Pfad zu den LISP-Dateien (aus Umgebungsvariable)
+;; Globale Variable: Pfad zu den LISP-Dateien
+;; Zuerst Umgebungsvariable, dann Heuristik aus MNL-Datei-Pfad
 (setq *ssg-lisp-pfad* (getenv "DXFM_LISP"))
 (if *ssg-lisp-pfad*
   (setq *ssg-lisp-pfad* (vl-string-translate "\\" "/" *ssg-lisp-pfad*))
+  ;; Fallback: Pfad aus MNL-Datei ableiten – menu/SSG_LIB.mnl → Lisp/
+  (progn
+    (setq *ssg-mnl-datei* (findfile "SSG_LIB.mnl"))
+    (if *ssg-mnl-datei*
+      (progn
+        (setq *ssg-mnl-datei* (vl-string-translate "\\" "/" *ssg-mnl-datei*))
+        (setq *ssg-menu-pos* (vl-string-search "/menu/" *ssg-mnl-datei*))
+        (if *ssg-menu-pos*
+          (progn
+            (setq *ssg-lisp-pfad*
+              (strcat (substr *ssg-mnl-datei* 1 *ssg-menu-pos*) "/Lisp"))
+            (if (findfile (strcat *ssg-lisp-pfad* "/ssg_core.lsp"))
+              (princ (strcat "\n[SSG_LIB] Pfad heuristisch ermittelt: " *ssg-lisp-pfad*))
+              (progn
+                (setq *ssg-lisp-pfad* nil)
+                (princ "\n[SSG_LIB] Heuristik fehlgeschlagen: ssg_core.lsp nicht gefunden.")
+              )
+            )
+          )
+        )
+      )
+    )
+  )
 )
 
 ;; ------------------------------------------------------------