Files
dxfmakros/Lisp/vf_etage.lsp
T
Michael StanglandClaude Opus 4.8 1e7a4d8620 [REFACTOR] VF: L_GF/L_VF-Solve aus Winkelberechnung zentralisiert (vf-winkel-solve)
Der L_GF/L_VF-Solve-Block (aus A/B-Restbudget) war in berechne-alle-winkel
(Standard) und berechne-winkel-etage byte-identisch. Als vf-winkel-solve
(winkel richtung A B sinα cosEff sinEff sin3 cos3) -> (winkel L_GF L_VF gueltig)
nach vf_core gezogen; beide Winkelberechnungen nutzen ihn jetzt.

Bewusst NICHT vereinheitlicht: die A/B-Berechnung (Etage hat zusaetzliche
2*schraeg-/2*gef-/2*feste-Terme, Standard nutzt feste-hz) und die Ergebnis-
tabelle (unterschiedliche Message-Keys/Arg-Form) - beides birgt Geometrie-/
Ausgaberisiko fuer geringen Zeilengewinn. Der identische, geometrie-kritische
Solve ist der wertvolle Teil.

test_foerderer.py (Winkel-Set, Monotonie, L_GF/L_VF>0) validiert das direkt.
Paren-Balance geprueft.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-08-29 10:17:40 +02:00

807 lines
36 KiB
Common Lisp
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;; ============================================================
;; 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. Pfad zentral ueber ssg_core
;; (ssg-lisp-verzeichnis), mit Inline-Fallback falls ssg_core hier noch nicht
;; geladen ist (nur relevant beim isolierten Einzel-Laden dieser Datei).
(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN"))))
(progn
(setq *vf-etage-core-pfad*
(if (car (atoms-family 1 '("SSG-LISP-VERZEICHNIS")))
(ssg-lisp-verzeichnis)
(cond
((getenv "DXFM_LISP") (vl-string-translate "\\" "/" (getenv "DXFM_LISP")))
((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*) *ssg-lisp-pfad*)
(t nil))))
(if *vf-etage-core-pfad*
(load (strcat *vf-etage-core-pfad* "/vf_core.lsp"))
(progn
(princ (ssg-text "vfe-warn-lisp-pfad"))
(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)
;; Schwenkwinkel der Ein-/Auslauf-Schraegsektionen: 30 Grad (AS_30/ES_30 +
;; 30-Grad-Gefaellebogen). War frueher 60. Nur noch im Laengen-/Hoehen-Budget
;; berechne-winkel-etage (schraeg-cos) verwendet; die fruehere absolute
;; hz-Platzierung wurde durch Frame-Verkettung (cur-hz) ersetzt.
(setq ETAGE_HZ_WINKEL 30)
;; ============================================================
;; TEIL 2: BIBLIOTHEK INITIALISIEREN (ETAGE-SPEZIFISCH)
;; ============================================================
(defun init-bibliothek-etage ( / temp-obj ks-data ks-ein-pos ks-aus-pos
gefaelle-blockname as30-blk es30-blk m)
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" (ssg-ils-blockname "AS_Element_30_rechts"))))
(setq *etage-lib-initialized* nil))
(if *etage-lib-initialized*
(progn (princ (ssg-text "vfe-bib-bereits-init")) t)
(progn
(princ (ssg-text "vfe-bib-initialisiere"))
;; Standard-Bogen-Daten laden (bogen-auf/bogen-ab benoetigt)
(if (not *lib-initialized*)
(init-bibliothek)
)
;; AS_30_rechts Masse extrahieren (KS_EIN->KS_AUS (dx dy dz) via vf-element-masse)
(princ (ssg-text "vfe-extrahiere-as30"))
(setq as30-blk (ensure-block-loaded "AS_Element_30_rechts"))
(ensure-block-loaded "AS_Element_30_links")
(setq m (if (tblsearch "BLOCK" as30-blk) (vf-element-masse "AS_Element_30_rechts")))
(if m
(progn
(setq etage-aus-dx (car m) etage-aus-dz (caddr m))
(princ (ssg-textf "vfe-as30-mass" (list (rtos etage-aus-dx 2 1) (rtos etage-aus-dz 2 1))))
)
(progn
(princ (ssg-text (if (tblsearch "BLOCK" as30-blk) "vfe-warn-ks-fehlt-standard" "vfe-warn-block-as30-fehlt")))
(setq etage-aus-dx 525.8 etage-aus-dz -72.9)
)
)
;; ES_30_rechts Masse extrahieren
(princ (ssg-text "vfe-extrahiere-es30"))
(setq es30-blk (ensure-block-loaded "ES_Element_30_rechts"))
(ensure-block-loaded "ES_Element_30_links")
(setq m (if (tblsearch "BLOCK" es30-blk) (vf-element-masse "ES_Element_30_rechts")))
(if m
(progn
(setq etage-ein-dx (car m) etage-ein-dz (caddr m))
(princ (ssg-textf "vfe-es30-mass" (list (rtos etage-ein-dx 2 1) (rtos etage-ein-dz 2 1))))
)
(progn
(princ (ssg-text (if (tblsearch "BLOCK" es30-blk) "vfe-warn-ks-fehlt-standard" "vfe-warn-block-es30-fehlt")))
(setq etage-ein-dx 576.2 etage-ein-dz -54.6)
)
)
;; Gefaellebogen_links_30 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_links_30_R500")
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(setq gefaelle-blockname (ensure-block-loaded gefaelle-blockname))
(setq m (if (tblsearch "BLOCK" gefaelle-blockname) (vf-element-masse "Gefaellebogen_links_30_R500")))
(if m
(setq etage-gef-dx-links (car m) etage-gef-dz-links (caddr m))
(progn
(princ (ssg-text (if (tblsearch "BLOCK" gefaelle-blockname) "vfe-warn-kein-ks-links" "vfe-warn-block-fehlt-links")))
(setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0)
)
)
(princ (ssg-textf "vfe-gefaellebogen-links-mass" (list (rtos etage-gef-dx-links 2 2) (rtos etage-gef-dz-links 2 2))))
;; Gefaellebogen_rechts_30 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_rechts_30_R500")
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(setq gefaelle-blockname (ensure-block-loaded gefaelle-blockname))
(setq m (if (tblsearch "BLOCK" gefaelle-blockname) (vf-element-masse "Gefaellebogen_rechts_30_R500")))
(if m
(setq etage-gef-dx-rechts (car m) etage-gef-dz-rechts (caddr m))
(progn
(princ (ssg-text (if (tblsearch "BLOCK" gefaelle-blockname) "vfe-warn-kein-ks-rechts" "vfe-warn-block-fehlt-rechts")))
(setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
)
)
(princ (ssg-textf "vfe-gefaellebogen-rechts-mass" (list (rtos etage-gef-dx-rechts 2 2) (rtos etage-gef-dz-rechts 2 2))))
(setq *etage-lib-initialized* t)
(princ (ssg-text "vfe-bib-init-erfolg"))
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))
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit)
)
)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0))
(setq matrix (vf-rot-matrix chz shz cv sv))
(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 (ssg-textf "vfe-hz-incl-status"
(list blockname (rtos laenge 2 0)
(strcat (rtos hz-winkel 2 0) (chr 176))
(strcat (rtos vert-winkel 2 0) (chr 176))
(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))
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(exit)
)
)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
(setq matrix (vf-rot-matrix chz shz cv sv))
(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 (ssg-textf "vfe-hz-rot-status"
(list blockname
(strcat (rtos hz-winkel 2 0) (chr 176))
(strcat (rtos vert-winkel 2 0) (chr 176))
(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)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(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 (vf-rot-matrix chz shz cv sv)))
(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 (ssg-textf "vfe-hz-rotks-status"
(list blockname
(strcat (rtos hz-winkel 2 0) (chr 176))
(rtos (caddr ausgang) 2 1))))
ausgang
)
(progn
(princ (ssg-textf "vfe-ks-fehlt-startpunkt" (list blockname)))
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)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
(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 (vf-rot-matrix chz shz cv sv)))
(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 (ssg-textf "vfe-hz-scaleks-status"
(list blockname (rtos laenge 2 0)
(strcat (rtos hz-winkel 2 0) (chr 176))
(rtos (caddr ausgang) 2 1))))
ausgang
)
(progn
(princ (ssg-textf "vfe-ks-fehlt-startpunkt" (list blockname)))
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 (ssg-text "vfe-alert-bib-nicht-init"))
(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 (ssg-text "vfe-berechnung-header"))
(princ "\n=========================================")
(princ (ssg-textf "vfe-delta-info" (list (rtos deltaL 2 2) (rtos deltaH 2 2) 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 (ssg-textf "vfe-bogen-nicht-vorhanden" (list (strcat (itoa winkel) (chr 176)))))
(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))
)
(setq ergebnis-liste
(cons (vf-winkel-solve winkel richtung A B sinα cosEff sinEff sin3 cos3)
ergebnis-liste))
)
)
)
(setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================")
(princ (ssg-text "vfe-ergebnistabelle-header"))
(princ "\n=================================================================================")
(princ (ssg-text "vfe-tabelle-spalten"))
(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 (ssg-textf "vfe-tabelle-zeile"
(list (strcat (itoa winkel) (chr 176)) (fmt L_GF) (fmt L_VF))))
(if gueltig
(progn
(princ (ssg-text "vfe-status-gueltig"))
(if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
)
)
(princ (ssg-text "vfe-status-ungueltig"))
)
)
(princ (ssg-textf "vfe-tabelle-zeile-fehler" (list (strcat (itoa winkel) (chr 176)))))
)
)
(princ "\n=================================================================================")
(if best-winkel
(princ (ssg-textf "vfe-empfohlener-winkel" (list (strcat (itoa best-winkel) (chr 176)))))
(princ (ssg-text "vfe-kein-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 (ssg-textf "vfe-gefaellebogen-seite-dx" (list seite (rtos etage-gef-dx 2 2))))
(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).
;; hz: Richtung der Hauptlinie (Default 0 = horizontal/X). AS-KS_EIN und
;; ES-KS_AUS liegen koaxial auf dieser Linie; die Kette wird frame-verkettet
;; aufgebaut (cur-hz laeuft durch, Boegen drehen um ihren gemessenen Schwenk).
(defun etage-foerderanlage-einfuegen (deltaL deltaH richtung
best-winkel L_GF1 L_GF2 L_VF
startpunkt seite hz
/ aktueller-punkt bogen-name endpunkt
bogen-mass bogen-dx bogen-dz
as-block es-block gefaelle-blockname
as-hz as-ksinfo
cur-hz bogen-info es-info
perp-sin perp-cos p2b-perp es-place-rad
es-wx es-wy es-perp perp-rate L-exit)
(setq aktueller-punkt startpunkt)
;; hz = Richtung der Hauptlinie (AS-KS_EIN / ES-KS_AUS liegen darauf).
;; Default 0 (horizontal), falls der Aufrufer nichts uebergibt.
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
(setq as-block (strcat "AS_Element_30_" seite))
(setq es-block (strcat "ES_Element_30_" seite))
;; Gefaellebogen auf der GEGENSEITE des AS-Elements (Nutzer-Vorgabe
;; 2026-07-21): AS links -> Boegen rechts, AS rechts -> Boegen links.
;; Beide Etage-Boegen nutzen dieselbe (Gegen-)Seite.
(setq gefaelle-blockname
(if (= seite "rechts")
"Gefaellebogen_links_30_R500"
"Gefaellebogen_rechts_30_R500"
))
;; Sentinel: Bibliothek neu initialisieren wenn Bloecke fehlen
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" (ssg-ils-blockname "AS_Element_30_rechts"))))
(setq *etage-lib-initialized* nil))
(if (not *etage-lib-initialized*) (init-bibliothek-etage))
;; 1. AS_30 - KS_EIN koaxial zur Hauptlinie (hz) ausrichten.
;; vf-element-ks-info liefert (ein-ang aus-ang vx vy): ein-ang/aus-ang sind die
;; Ebenen-Winkel der KS_EIN- bzw. KS_AUS-Achse IM BLOCK (bei Einbau-Rotation 0).
;; Platzierungs-hz = (hz - ein-ang) dreht die KS_EIN-Achse von ein-ang auf hz
;; -> KS_EIN liegt koaxial auf der Hauptlinie (Abnahmekriterium).
(princ (ssg-textf "vfe-step1-as30" (list as-block)))
(setq as-ksinfo (vf-element-ks-info as-block))
(setq aktueller-punkt
(insert-block-by-ks as-block aktueller-punkt (- hz (car as-ksinfo))))
;; KS_AUS-Richtung (absolut) = hz + Schwenk (aus-ang - ein-ang); die folgende
;; GF laeuft in dieser Richtung weiter (Frame-Verkettung wie im Linienzug).
(setq as-hz (+ hz (- (cadr as-ksinfo) (car as-ksinfo))))
;; 2. Staustrecke 400mm (folgt der AS-Richtung as-hz, 3 Grad vert, KS_EIN)
(princ (ssg-textf "vfe-step2" (list (rtos as-hz 2 1))))
(setq aktueller-punkt
(insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
400 as-hz 3))
;; 3. Separator (folgt der AS-Richtung as-hz, 3 Grad vert)
(princ (ssg-textf "vfe-step3" (list (rtos as-hz 2 1))))
(setq aktueller-punkt
(insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
as-hz 3 300 0))
;; Ab hier laufende Richtung cur-hz mitfuehren (frame-verkettet). Start =
;; KS_AUS-Richtung des AS (as-hz). Jeder Gefaellebogen dreht cur-hz um seinen
;; gemessenen Schwenk (Vorzeichen/Seite kommen aus dem Block).
(setq cur-hz as-hz)
;; 4. Gefaellebogen Anfang (verkettet: KS_EIN auf cur-hz, dann cur-hz drehen)
(setq bogen-info (vf-element-ks-info gefaelle-blockname))
(princ (ssg-textf "vfe-step4" (list gefaelle-blockname (rtos cur-hz 2 1))))
(setq aktueller-punkt
(insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt
(- cur-hz (car bogen-info)) 0))
(setq cur-hz (+ cur-hz (- (cadr bogen-info) (car bogen-info))))
;; 5. L_GF1 (3 Grad geneigt)
(if (> L_GF1 0.1)
(progn
(princ (ssg-textf "vfe-step5-strecke" (list (rtos L_GF1 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3 cur-hz))
)
(princ (ssg-text "vfe-step5-skip"))
)
;; 6. Umlenkstation (3 Grad geneigt)
(princ (ssg-text "vfe-step6"))
(setq aktueller-punkt
(insert-rotated-block-with-ks (strcat "Vario_Umlenkstation_500mm_" (vf-motorseite-aktuell)) aktueller-punkt 3 500 0 cur-hz))
;; 7. 1. Vertikalbogen (3 Grad geneigt)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (ssg-textf "vfe-step7" (list bogen-name)))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz cur-hz))
;; 8. Variable Strecke L_VF
(if (> L_VF 0.1)
(progn
(if (= richtung "Auf")
(progn
(princ (ssg-textf "vfe-step8-auf" (list (itoa (- (- best-winkel 3))) (rtos L_VF 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (- (- best-winkel 3)) cur-hz))
)
(progn
(princ (ssg-textf "vfe-step8-ab" (list (itoa (+ best-winkel 3)) (rtos L_VF 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (+ best-winkel 3) cur-hz))
)
)
)
(princ (ssg-text "vfe-step8-skip"))
)
;; 9. 2. Vertikalbogen
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(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 (ssg-textf "vfe-step9-bogen" (list bogen-name (itoa (- 3 best-winkel)))))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(- 3 best-winkel) bogen-dx bogen-dz cur-hz))
)
(progn
(princ (ssg-textf "vfe-step9-bogen" (list bogen-name (itoa (+ best-winkel 3)))))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(+ best-winkel 3) bogen-dx bogen-dz cur-hz))
)
)
;; 10. Motorstation (3 Grad geneigt)
(princ (ssg-text "vfe-step10"))
(setq aktueller-punkt
(insert-rotated-block-with-ks (strcat "Vario_Motorstation_500mm_" (vf-motorseite-aktuell)) aktueller-punkt 3 500 0 cur-hz))
;; 11. L_GF2 (3 Grad geneigt)
(if (> L_GF2 0.1)
(progn
(princ (ssg-textf "vfe-step11-gf2" (list (rtos L_GF2 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF2 3 cur-hz))
)
(princ (ssg-text "vfe-step11-skip"))
)
;; 12. Gefaellebogen Ende (verkettet: KS_EIN auf cur-hz, dann cur-hz drehen)
(setq bogen-info (vf-element-ks-info gefaelle-blockname))
(princ (ssg-textf "vfe-step12" (list gefaelle-blockname (rtos cur-hz 2 1))))
(setq aktueller-punkt
(insert-block-by-ks gefaelle-blockname aktueller-punkt (- cur-hz (car bogen-info))))
(setq cur-hz (+ cur-hz (- (cadr bogen-info) (car bogen-info))))
;; --- Auslauf RUECKWAERTS vom ES gerechnet (analog Linienzug Modus 2):
;; die Auslauf-Staustrecke wird variabel, sodass das ES-KS_AUS OHNE
;; seitlichen Versatz auf der Hauptachse landet. Reihenfolge (Nutzer-Vorgabe):
;; Staustrecke -> Separator -> ES.
(setq es-info (vf-element-ks-info es-block))
;; perp = Einheitsvektor senkrecht zur Hauptlinie hz: (-sin hz, cos hz)
(setq perp-sin (sin (* hz (/ pi 180.0)))
perp-cos (cos (* hz (/ pi 180.0))))
;; seitliche Lage nach Bogen2 (perp-Abstand des aktuellen Punkts zu startpunkt)
(setq p2b-perp (+ (* (- (car aktueller-punkt) (car startpunkt)) (- perp-sin))
(* (- (cadr aktueller-punkt) (cadr startpunkt)) perp-cos)))
;; ES-Eigenversatz KS_EIN->KS_AUS (Block vx/vy) in Auslaufrichtung gedreht -> perp
(setq es-place-rad (* (- cur-hz (car es-info)) (/ pi 180.0)))
(setq es-wx (- (* (caddr es-info) (cos es-place-rad)) (* (cadddr es-info) (sin es-place-rad))))
(setq es-wy (+ (* (caddr es-info) (sin es-place-rad)) (* (cadddr es-info) (cos es-place-rad))))
(setq es-perp (+ (* es-wx (- perp-sin)) (* es-wy perp-cos)))
;; perp-Auslenkung pro Laengeneinheit bei cur-hz (Neigung 3 Grad)
(setq perp-rate (* (cos (* 3.0 (/ pi 180.0)))
(sin (* (- cur-hz hz) (/ pi 180.0)))))
;; Loesen: p2b-perp + (L_exit + 300)*perp-rate + es-perp = 0
(setq L-exit
(if (> (abs perp-rate) 1e-6)
(- (/ (- (+ p2b-perp es-perp)) perp-rate) 300.0)
400.0))
(if (< L-exit 50.0) (setq L-exit 50.0)) ; Schutz gegen negative/zu kurze GF
;; 13. Auslauf-Staustrecke (variabel, folgt cur-hz, 3 Grad vert, KS_EIN)
(princ (ssg-textf "vfe-step13" (list (rtos L-exit 2 1) (rtos cur-hz 2 1))))
(setq aktueller-punkt
(insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt
L-exit cur-hz 3))
;; 14. Separator (verkettet, folgt cur-hz, 3 Grad vert)
(princ (ssg-textf "vfe-step14" (list (rtos cur-hz 2 1))))
(setq aktueller-punkt
(insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
cur-hz 3 300 0))
;; 15. ES_30 (verkettet: KS_EIN auf cur-hz; KS_AUS auf der Hauptlinie)
(princ (ssg-textf "vfe-step15" (list es-block (rtos cur-hz 2 1))))
(setq endpunkt
(insert-block-by-ks es-block aktueller-punkt (- cur-hz (car es-info))))
(princ "\n\n=========================================")
(princ (ssg-text "vfe-eingefuegt"))
endpunkt
)
;; ============================================================
;; TEIL 7: DCL-DIALOG (Neuanlage + Edit)
;; ============================================================
;; Der Etage-Typ nutzt dieselben Dialoge wie der Standard-Typ
;; (vfs-dialog-eingabe-basis / vfs-dialog-winkel-verteilung in vf_standard.lsp).
;; Unterschiede zum Standard-Ablauf: Berechnung ueber berechne-etage (braucht
;; seite), Einfuegung ueber etage-foerderanlage-einfuegen, KEINE horizontale
;; Zwischenstrecke (Winkel-Sentinel 0). XDATA-Marker "etage".
;; Duenner Wrapper auf den gemeinsamen vf-dialog-berechnen-einfuegen (vf_core).
;; Etage = OHNE horizontale Zwischenstrecke (horizontal-p nil).
(defun vfe-etage-dialog-berechnen-einfuegen (vf-nummer deltaL deltaH richtung startpunkt hz seite
winkel-prefill geruest-einzelmodul geruest-typ)
(vf-dialog-berechnen-einfuegen "etage" vf-nummer deltaL deltaH richtung startpunkt hz seite
winkel-prefill geruest-einzelmodul geruest-typ nil))
;; Neuanlage (Menue/Konsole -> Dialog): Startpunkt (X/Y) picken, Basis-Dialog,
;; dann gemeinsame Berechnung/Winkel-Dialog/Einfuegung.
;; Analog vfs-standard-dialog-ablauf in vf_standard.lsp.
(defun vfe-etage-dialog-ablauf (vf-nummer)
(vf-dialog-ablauf "etage" vf-nummer nil))
;; Edit eines bestehenden Etage-VF-Blocks (VF_n mit SSG_VF_EDIT-XDATA "etage").
;; Wird von c:VARIOFOERDERER_EDIT (vf_standard.lsp) per Typ-Dispatch gerufen und
;; laeuft innerhalb der dort geoeffneten ssg-start-Sitzung. Liest Parameter aus
;; XDATA/Attributen, zeigt sie vorbelegt und baut bei OK am selben Startpunkt neu
;; auf. Analog dem Standard-Edit-Body in c:VARIOFOERDERER_EDIT.
(defun vfe-edit-ent (ent / ed bname startpunkt attribs xd
deltaL deltaH richtung z-start hz seite dim
eingabe vf-nummer best-winkel-attr L_GF_m-teile
prefill-basis prefill-winkel
geruest-einzelmodul geruest-typ motorseite)
(setq ed (entget ent))
(setq bname (cdr (assoc 2 ed)))
(setq xd (vfs-xdata-lesen ent))
(setq startpunkt (cdr (assoc 10 ed)))
(setq attribs (ssg-attrib-read ent))
(setq hz (atof (nth 1 xd)))
(setq deltaL (atof (cond ((cdr (assoc "DELTA_L_mm" attribs))) ("15000"))))
(setq deltaH (atof (cond ((cdr (assoc "DELTA_H_mm" attribs))) ("0"))))
(setq richtung (cond ((cdr (assoc "ANTRIEBFAHRTRICHTUNG" attribs))) ("Auf")))
(setq seite (cond ((cdr (assoc "SEITE_AS" attribs))) ("links")))
(setq z-start (caddr startpunkt))
(setq prefill-basis
(list (cons "deltaL" deltaL) (cons "deltaH" deltaH) (cons "richtung" richtung)
(cons "einfuegehoehe" z-start) (cons "hz" hz) (cons "seite" seite)
(cons "dim" (cond ((ssg-dim-xdata-lesen ent)) ("3D")))
(cons "geruest-einzelmodul" (cond ((cdr (assoc "GERUEST_EINZELMODUL" attribs))) ("1")))
(cons "geruest-typ" (cdr (assoc "GERUEST_TYP" attribs)))
(cons "motorseite" (cond ((cdr (assoc "MOTORSEITE" attribs))) ("rechts")))))
(setq eingabe (vfs-dialog-eingabe-basis prefill-basis))
(if (null eingabe)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(vf-basis-eingabe-entpacken eingabe)
(setq startpunkt (list (car startpunkt) (cadr startpunkt) z-start))
(setq best-winkel-attr (atoi (cond ((cdr (assoc "VF_WINKEL" attribs))) ("0"))))
(setq L_GF_m-teile (ssg-cfg-split-comma (cond ((cdr (assoc "L_GF_m" attribs))) ("0.0,0.0"))))
(setq prefill-winkel
(list (cons "winkel" best-winkel-attr)
(cons "verteilung-idx" "3")
(cons "lgf1" (* 1000.0 (atof (car L_GF_m-teile))))))
(setq *ssg-ils-dim* dim)
(setq *vf-motorseite* motorseite)
(entdel ent)
(setq vf-nummer (vf-next-number))
(vfe-etage-dialog-berechnen-einfuegen vf-nummer deltaL deltaH richtung
startpunkt hz seite prefill-winkel geruest-einzelmodul geruest-typ)
(setq *ssg-ils-dim* nil)
(setq *vf-motorseite* nil)
(princ (ssg-textf "vfs-edit-neu-aufgebaut" (list bname)))
)
)
)
;; ============================================================
;; REGISTRIERUNG
;; ============================================================
(vf-typ-registrieren
"etage"
'berechne-etage
'etage-foerderanlage-einfuegen
(ssg-text "vfc-typ-etage-beschreibung"))
(princ "\n>>> vf_etage.lsp geladen - Typ 'etage' registriert")
(princ)