Files
dxfmakros/Lisp/vf_etage.lsp
T
Michael StanglandClaude Opus 4.8 2eca169326 Uebersetzung aller Benutzermeldungen auf ssg-text/ssg-textf umgestellt
Vollstaendiger i18n-Rollout ueber alle Feature- und Kernmodule: alle benutzersichtbaren princ/prompt/getXXX/alert-Texte laufen jetzt ueber die zentrale Sprachtabelle in ssg_lang.lsp (Deutsch/Englisch, umschaltbar via SSG_SPRACHE). 403 Tabelleneintraege, 497 Aufrufstellen in 17 Dateien.

Ausgeschlossen wie geplant: Debug-Ausgaben (dbg*), Lademeldungen, [DUMMY]-Platzhalter, [CFG]/[OMNI]-Diagnosemarker.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-15 21:24:18 +02:00

789 lines
32 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
(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN"))))
(progn
(setq *vf-etage-core-pfad*
(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)
(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" "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
(princ (ssg-text "vfe-extrahiere-as30"))
(ensure-block-loaded "AS_Element_30_rechts")
(ensure-block-loaded "AS_Element_30_links")
(if (tblsearch "BLOCK" "AS_Element_30_rechts")
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"AS_Element_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 (ssg-textf "vfe-as30-mass" (list (rtos etage-aus-dx 2 1) (rtos etage-aus-dz 2 1))))
)
(progn
(princ (ssg-text "vfe-warn-ks-fehlt-standard"))
(setq etage-aus-dx 525.8 etage-aus-dz -72.9)
)
)
)
(progn
(princ (ssg-text "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"))
(ensure-block-loaded "ES_Element_30_rechts")
(ensure-block-loaded "ES_Element_30_links")
(if (tblsearch "BLOCK" "ES_Element_30_rechts")
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"ES_Element_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 (ssg-textf "vfe-es30-mass" (list (rtos etage-ein-dx 2 1) (rtos etage-ein-dz 2 1))))
)
(progn
(princ (ssg-text "vfe-warn-ks-fehlt-standard"))
(setq etage-ein-dx 576.2 etage-ein-dz -54.6)
)
)
)
(progn
(princ (ssg-text "vfe-warn-block-es30-fehlt"))
(setq etage-ein-dx 576.2 etage-ein-dz -54.6)
)
)
;; Gefaellebogen_links_60 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_links_60_R500")
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(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 (ssg-text "vfe-warn-kein-ks-links"))
(setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0)
)
)
)
(progn
(princ (ssg-text "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_60 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_rechts_60_R500")
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(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 (ssg-text "vfe-warn-kein-ks-rechts"))
(setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0)
)
)
)
(progn
(princ (ssg-text "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))
(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 (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 (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))
(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 (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 (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)
(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
(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 (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)
(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
(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 (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))
)
(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 (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: Parameter fuer Registry-Kompatibilitaet mit variofoerderer-einfuegen
;; (siehe c:VarioFoerderer) - wird hier NICHT verwendet: die Etage-Anlage hat
;; bereits eine eigene, fest verdrahtete horizontale Geometrie (hz-anfang/
;; hz-ende fuer den 60-Grad-Uebereinander-Versatz) und unterstuetzt aktuell
;; keine zusaetzliche globale Fahrtrichtung.
(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
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 "AS_Element_30_" seite))
(setq es-block (strcat "ES_Element_30_" seite))
(setq gefaelle-blockname
(if (= seite "rechts")
"Gefaellebogen_rechts_60_R500"
"Gefaellebogen_links_60_R500"
))
;; Sentinel: Bibliothek neu initialisieren wenn Bloecke fehlen
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "AS_Element_30_rechts")))
(setq *etage-lib-initialized* nil))
(if (not *etage-lib-initialized*) (init-bibliothek-etage))
;; 1. AS_30
(princ (ssg-textf "vfe-step1-as30" (list as-block)))
(setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt 0.0))
;; 2. Staustrecke 400mm (hz-anfang, 3 Grad vert, KS_EIN)
(princ (ssg-textf "vfe-step2" (list (itoa hz-anfang))))
(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 (ssg-textf "vfe-step3" (list (itoa hz-anfang))))
(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 (ssg-textf "vfe-step4" (list gefaelle-blockname (itoa hz-anfang))))
(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 (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 0.0))
)
(princ (ssg-text "vfe-step5-skip"))
)
;; 6. Umlenkstation (3 Grad geneigt)
(princ (ssg-text "vfe-step6"))
(setq aktueller-punkt
(insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3 500 0 0.0))
;; 7. 1. Vertikalbogen (3 Grad geneigt)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
(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 0.0))
;; 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)) 0.0))
)
(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) 0.0))
)
)
)
(princ (ssg-text "vfe-step8-skip"))
)
;; 9. 2. Vertikalbogen
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
(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 0.0))
)
(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 0.0))
)
)
;; 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 0.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 0.0))
)
(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 0.0))
;; 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)