;; ============================================================ ;; 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")))) (progn (setq *vf-std-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-std-core-pfad* (load (strcat *vf-std-core-pfad* "/vf_core.lsp")) (progn (princ "\n[vf_standard] WARNUNG: Lisp-Pfad nicht ermittelbar - vf_core.lsp nicht ladbar!") (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: BLOCK-DATEI-PRUEFUNG ;; ============================================================ ;; Prueft ob alle benoetigten Block-Dateien vorhanden sind. ;; Gibt t zurueck wenn OK (oder Library-DXF vorhanden), nil wenn Einzeldateien fehlen. (defun vf-check-required-blocks ( / lib-datei bogen-winkel required-blocks missing bname datei) (setq lib-datei (strcat (vl-string-translate "\\" "/" (getenv "DXFM_DATA")) "/block_libraries/ils_library.dxf")) (if (findfile lib-datei) t ;; Library-Datei vorhanden: alle Bloecke darin verfuegbar (progn (setq bogen-winkel (ssg-cfg-or "vario" "bogen_winkel" '(3 6 9 12 15 18 21 27 33 39 45 51))) (setq required-blocks (append (list "_3D_AS_90_links" "_3D_AS_90_rechts" "_3D_ES_90_links" "_3D_ES_90_rechts" "Staustrecke_SP_1000_mm" "Staustrecke_Separator_SP_300_mm" "Vario_Umlenkstation_500mm" "Vario_Motorstation_500mm") (mapcar (function (lambda (w) (strcat "Vario_Bogen_auf_" (itoa w) grad-zeichen))) bogen-winkel) (mapcar (function (lambda (w) (strcat "Vario_Bogen_ab_" (itoa w) grad-zeichen))) bogen-winkel) ) ) (setq missing '()) (foreach bname required-blocks (setq datei (strcat block-pfad bname ".dxf")) (if (not (findfile datei)) (setq missing (cons datei missing)) ) ) (if missing (progn (princ (strcat "\n FEHLER: DXFM_BLOCKS = " block-pfad)) (princ "\n Folgende Block-Dateien fehlen:") (foreach f (reverse missing) (princ (strcat "\n - " f)) ) nil ) t ) ) ) ) ;; ============================================================ ;; TEIL 3: 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 ) (if (not (vf-check-required-blocks)) nil (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 ) ;; end progn (Initialisierung) ) ;; end (if not vf-check-required-blocks) ) ;; end outer (if and *lib-initialized*) ) ;; ============================================================ ;; 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 (or (not *lib-initialized*) (null aus-dz) (null ein-dz)) (progn (princ "\n FEHLER: Bibliothek nicht korrekt initialisiert (AUS/EIN-Masse fehlen)!") (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)