mistangl/dxfmakros
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
dea039f34933c3eb34deaa9948be51f245c61633
dxfmakros/Lisp/vf_etage.lsp
T

785 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"))))
(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)
Reference in New Issue View Git Blame Copy Permalink