;; ============================================================ ;; FÖRDERANLAGE GENERATOR für BricsCAD Pro ;; Version: 24.3 (Korrigierte Methodenzuordnung) ;; Befehl: FOERDERANLAGE ;; ============================================================ (vl-load-com) ;; ============================================================ ;; TEIL 1: GLOBALE EINSTELLUNGEN ;; ============================================================ (if (getenv "DXFM_BLOCKS") (setq modul-pfad (strcat (getenv "DXFM_BLOCKS") "/")) (progn (alert "Umgebungsvariable DXFM_BLOCKS nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.") (exit) ) ) ;; Pfad zur Koordinaten-Bibliothek (neue Bogen-Bloecke mit KS_EIN/KS_AUS) (if (getenv "DXFM_DATA") (setq koordinaten-lib (strcat (getenv "DXFM_DATA") "/block_libraries/ils_vario_koordinaten.dwg")) (progn (alert "Umgebungsvariable DXFM_DATA nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.") (exit) ) ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq modelspace (vla-get-ModelSpace doc)) ;; ============================================================ ;; TEIL 2: FESTE MODUL-MASSE ;; ============================================================ (setq aus-dx 531.85) (setq aus-dy -496.11) (setq aus-dz -12.92) (setq ein-dx 468.94) (setq ein-dy 449.13) (setq ein-dz -167.89) (setq separator-laenge 300) (setq spannstation-laenge 500) (setq motorstation-laenge 500) (setq staustrecke-basis 1000) (setq FESTE_HORIZONTAL 1600) ;; ============================================================ ;; KONFIGURATION: Flag für dynamische BoundingBox-Berechnung ;; Setze auf t für dynamische Berechnung aus .dwg-Dateien ;; Setze auf nil für feste, hartkodierte Werte ;; ============================================================ (setq use-dynamic-bbox nil) ;; Ändere hier: t = dynamisch, nil = hartkodiert ;; ============================================================ ;; Feste, hartkodierte Bogen-Tabellen (Fallback) ;; ============================================================ (setq bogen-auf-unten-hardcoded '((3 399.73 0 0)(9 297.95 0 15.61)(12 296.52 0 23.34) (15 593.04 0 62.33)(24 583.13 0 100.09)(36 847.53 0 234.76) (48 1063.24 0 448.91)) ) (setq bogen-auf-oben-hardcoded '((3 391.46 0 0)(9 281.45 0 14.75)(12 275.96 0 21.72) (15 568.46 0 59.75)(24 546.87 0 93.37)(36 796.96 0 219.78) (48 1000.4 0 422.88)) ) (setq bogen-ab-oben-hardcoded '((9 389.31 0 -40.92)(12 284.23 0 -37.42)(15 389.31 0 -40.92) (24 552.27 0 -124.51)(36 796.35 0 -265.43)(48 732.51 0 -349.39)) ) (setq bogen-ab-unten-hardcoded '((9 397.54 0 -41.78)(12 296.52 0 -39.04)(15 493.38 0 -70.19) (24 580.27 0 -131.23)(36 838.65 0 -280.41)(48 787.08 0 -375.42)) ) ;; ============================================================ ;; Funktion zum Berechnen der BoundingBox eines Blocks (temporäres Einfügen) ;; ============================================================ (defun get-block-bbox (blockname / obj minpt maxpt dx dz) (if (findfile blockname) (progn ;; Temporär einfügen bei (0,0,0) (setq obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) ;; BoundingBox abfragen (vla-GetBoundingBox obj 'minpt 'maxpt) (setq minpt (vlax-safearray->list minpt)) (setq maxpt (vlax-safearray->list maxpt)) ;; Differenzen berechnen (setq dx (- (car maxpt) (car minpt))) ;; X-Ausdehnung (setq dz (- (caddr maxpt) (caddr minpt))) ;; Z-Ausdehnung ;; Objekt löschen (vla-Delete obj) ;; Rückgabe: (dx 0 dz) (list dx 0 dz) ) (progn (princ (strcat "\nFEHLER: Blockdatei nicht gefunden: " blockname)) '(0 0 0) ;; Fallback ) ) ) ;; ============================================================ ;; Funktion zum Erstellen der Bogen-Tabellen dynamisch ;; ============================================================ (defun create-bogen-table (richtung unten-oben / winkel-list table bbox) (setq winkel-list '(3 9 12 15 24 36 48)) (setq table '()) (foreach winkel winkel-list (setq blockname (strcat modul-pfad "Vertikalbogen_" richtung "_" (itoa winkel) "_" unten-oben ".dwg")) (setq bbox (get-block-bbox blockname)) (if (and (> (car bbox) 0) (> (caddr bbox) 0)) ;; Nur gültige Werte (setq table (cons (cons winkel bbox) table)) (princ (strcat "\nWARNUNG: Ungültige BoundingBox für " blockname)) ) ) (reverse table) ) ;; ============================================================ ;; TEIL 3: BOGEN-MASSE (Verzweigung basierend auf Flag) ;; ============================================================ (if use-dynamic-bbox (progn (princ "\nVerwende dynamische BoundingBox-Berechnung für Bogen-Tabellen...") (if (null bogen-auf-unten) (progn (setq bogen-auf-unten (create-bogen-table "Auf" "Unten")) (setq bogen-auf-oben (create-bogen-table "Auf" "Oben")) (setq bogen-ab-oben (create-bogen-table "Ab" "Oben")) (setq bogen-ab-unten (create-bogen-table "Ab" "Unten")) (princ "\nDynamische Bogen-Tabellen initialisiert.") ) ) ) (progn (princ "\nVerwende hartkodierte Werte für Bogen-Tabellen...") (setq bogen-auf-unten bogen-auf-unten-hardcoded) (setq bogen-auf-oben bogen-auf-oben-hardcoded) (setq bogen-ab-oben bogen-ab-oben-hardcoded) (setq bogen-ab-unten bogen-ab-unten-hardcoded) (princ "\nHartkodierte Bogen-Tabellen geladen.") ) ) ;; ============================================================ ;; TEIL 4: HILFSFUNKTIONEN ;; ============================================================ (defun punkt-differenz (p1 p2) (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1))) ) (defun get-bogen-mass (tabelle winkel) (setq result nil) (foreach item tabelle (if (= (car item) winkel) (setq result (cdr item)))) (if (null result) (setq result '(800 0 0))) result ) (defun get-bogen-mass-mit-abs (tabelle winkel) (setq result nil) (foreach item tabelle (if (= (car item) winkel) (setq result (list (cadr item) (caddr item) (abs (cadddr item)))))) (if (null result) (setq result '(800 0 0))) result ) (defun fmt (x) (if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---") ) ;; ============================================================ ;; TEIL 4b: KS_EIN / KS_AUS KOORDINATEN EXTRAHIEREN ;; ============================================================ ;; Grad-Zeichen fuer Blocknamen (setq grad-zeichen (chr 176)) ;; ° ;; Berechne die Laenge eines 3D-Vektors (defun vec-length (v) (sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v)))) ) ;; Bestimme die Achse anhand der Linienlaenge innerhalb eines KS-Blocks ;; KS_EIN: X=1, Y=2, Z=3 ;; KS_AUS: X=100, Y=2, Z=3 (defun ks-line-axis (len) (cond ((< (abs (- len 1.0)) 0.5) "X") ((< (abs (- len 100.0)) 0.5) "X") ((< (abs (- len 2.0)) 0.5) "Y") ((< (abs (- len 3.0)) 0.5) "Z") (t nil) ) ) ;; Importiere Blockdefinitionen aus der Koordinaten-Bibliothek. ;; Fuegt die DWG temporaer ein (dadurch werden alle Blockdefs geladen) ;; und loescht die Einfuegung sofort wieder. (defun load-koordinaten-lib ( / temp-obj) (if (findfile koordinaten-lib) (progn (princ "\n Lade Blockdefinitionen aus Koordinaten-Bibliothek...") (setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) koordinaten-lib 1.0 1.0 1.0 0)) (vla-Delete temp-obj) (princ " OK.") t ) (progn (princ (strcat "\n FEHLER: Koordinaten-Bibliothek nicht gefunden: " koordinaten-lib)) nil ) ) ) ;; Extrahiere KS_EIN und KS_AUS Koordinaten aus einem eingefuegten Bogen-Block. ;; Der Block wird temporaer explodiert, die KS-Daten ausgelesen, ;; alle explodierten Entities wieder geloescht. Der Original-Block bleibt erhalten. ;; Gibt eine assoc-Liste zurueck: ;; (("KS_EIN" (origin x-end y-end z-end x-dir y-dir z-dir)) ;; ("KS_AUS" (origin x-end y-end z-end x-dir y-dir z-dir))) ;; origin/x-end/y-end/z-end = 3D-Punkte (Weltkoordinaten) ;; x-dir/y-dir/z-dir = normalisierte Richtungsvektoren des KOS (defun extract-ks-from-block (block-obj / sub-entities sub-obj ks-results ks-ref inner-entities inner-obj line-start line-end line-vec line-len axis origin x-end y-end z-end) (setq ks-results '()) ;; Block explodieren (erzeugt neue Entities, Original bleibt) (setq sub-entities (vlax-invoke block-obj 'Explode)) (foreach sub-obj sub-entities (if (and (not (vlax-erased-p sub-obj)) (= (vla-get-ObjectName sub-obj) "AcDbBlockReference") (or (= (vla-get-Name sub-obj) "KS_EIN") (= (vla-get-Name sub-obj) "KS_AUS"))) (progn (setq ks-ref (vla-get-Name sub-obj)) ;; KS-Block exploden um die Linien mit Weltkoordinaten zu lesen (setq inner-entities (vlax-invoke sub-obj 'Explode)) (setq origin nil x-end nil y-end nil z-end nil) (foreach inner-obj inner-entities (if (and (not (vlax-erased-p inner-obj)) (= (vla-get-ObjectName inner-obj) "AcDbLine")) (progn (setq line-start (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint inner-obj)))) (setq line-end (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint inner-obj)))) (setq line-vec (list (- (car line-end) (car line-start)) (- (cadr line-end) (cadr line-start)) (- (caddr line-end) (caddr line-start)))) (setq line-len (vec-length line-vec)) (setq axis (ks-line-axis line-len)) ;; Ursprung = gemeinsamer Startpunkt aller Linien (if (null origin) (setq origin line-start)) (cond ((= axis "X") (setq x-end line-end)) ((= axis "Y") (setq y-end line-end)) ((= axis "Z") (setq z-end line-end)) ) ) ) ;; Temporaere innere Objekte loeschen (if (not (vlax-erased-p inner-obj)) (vla-Delete inner-obj)) ) ;; Richtungsvektoren berechnen (Endpunkt - Ursprung, normalisiert) (setq x-dir nil y-dir nil z-dir nil) (if (and origin x-end) (progn (setq x-dir (list (- (car x-end) (car origin)) (- (cadr x-end) (cadr origin)) (- (caddr x-end) (caddr origin)))) (setq vlen (vec-length x-dir)) (if (> vlen 0.001) (setq x-dir (list (/ (car x-dir) vlen) (/ (cadr x-dir) vlen) (/ (caddr x-dir) vlen))) ) ) ) (if (and origin y-end) (progn (setq y-dir (list (- (car y-end) (car origin)) (- (cadr y-end) (cadr origin)) (- (caddr y-end) (caddr origin)))) (setq vlen (vec-length y-dir)) (if (> vlen 0.001) (setq y-dir (list (/ (car y-dir) vlen) (/ (cadr y-dir) vlen) (/ (caddr y-dir) vlen))) ) ) ) (if (and origin z-end) (progn (setq z-dir (list (- (car z-end) (car origin)) (- (cadr z-end) (cadr origin)) (- (caddr z-end) (caddr origin)))) (setq vlen (vec-length z-dir)) (if (> vlen 0.001) (setq z-dir (list (/ (car z-dir) vlen) (/ (cadr z-dir) vlen) (/ (caddr z-dir) vlen))) ) ) ) ;; Ergebnis: (name (origin x-end y-end z-end x-dir y-dir z-dir)) (setq ks-results (cons (list ks-ref (list origin x-end y-end z-end x-dir y-dir z-dir)) ks-results)) (princ (strcat "\n " ks-ref " Koordinatensystem:")) (if origin (princ (strcat "\n Ursprung: (" (rtos (car origin) 2 4) ", " (rtos (cadr origin) 2 4) ", " (rtos (caddr origin) 2 4) ")"))) (if x-end (princ (strcat "\n X-Ende: (" (rtos (car x-end) 2 4) ", " (rtos (cadr x-end) 2 4) ", " (rtos (caddr x-end) 2 4) ")"))) (if y-end (princ (strcat "\n Y-Ende: (" (rtos (car y-end) 2 4) ", " (rtos (cadr y-end) 2 4) ", " (rtos (caddr y-end) 2 4) ")"))) (if z-end (princ (strcat "\n Z-Ende: (" (rtos (car z-end) 2 4) ", " (rtos (cadr z-end) 2 4) ", " (rtos (caddr z-end) 2 4) ")"))) (if x-dir (princ (strcat "\n X-Richtung: (" (rtos (car x-dir) 2 6) ", " (rtos (cadr x-dir) 2 6) ", " (rtos (caddr x-dir) 2 6) ")"))) (if y-dir (princ (strcat "\n Y-Richtung: (" (rtos (car y-dir) 2 6) ", " (rtos (cadr y-dir) 2 6) ", " (rtos (caddr y-dir) 2 6) ")"))) (if z-dir (princ (strcat "\n Z-Richtung: (" (rtos (car z-dir) 2 6) ", " (rtos (cadr z-dir) 2 6) ", " (rtos (caddr z-dir) 2 6) ")"))) ) ) ) ;; Alle explodierten Objekte loeschen (foreach sub-obj sub-entities (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj)) ) ks-results ) ;; Bogen-Block aus der Koordinaten-Bibliothek einfuegen und KS-Daten extrahieren. ;; bogen-name = Blockname ohne Grad-Zeichen (z.B. "Vario_Bogen_auf_3") ;; einfuege-punkt = Punkt an dem der Block eingefuegt wird ;; Gibt die KS-Ergebnisse zurueck. Der Block bleibt eingefuegt. (defun insert-bogen-from-lib (bogen-name einfuege-punkt / full-name block-obj ks-data) (setq full-name (strcat bogen-name grad-zeichen)) (princ (strcat "\n Fuege Block '" full-name "' ein...")) ;; Blockdefinitionen laden (falls noch nicht geschehen) (if (not (tblsearch "BLOCK" full-name)) (load-koordinaten-lib) ) ;; Block per Name einfuegen (if (tblsearch "BLOCK" full-name) (progn (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point einfuege-punkt) full-name 1.0 1.0 1.0 0)) (princ (strcat "\n Einfuegen bei: X=" (rtos (car einfuege-punkt) 2 2) ", Y=" (rtos (cadr einfuege-punkt) 2 2) ", Z=" (rtos (caddr einfuege-punkt) 2 2))) ;; KS-Koordinaten extrahieren (princ "\n Extrahiere Koordinatensysteme...") (setq ks-data (extract-ks-from-block block-obj)) ks-data ) (progn (princ (strcat "\n FEHLER: Block '" full-name "' nicht in Bibliothek gefunden!")) nil ) ) ) ;; ============================================================ ;; ActiveX Block einfügen ;; ============================================================ (defun InsertBlock (name punkt skala-x) (setq insertionPoint (vlax-3D-point punkt)) (vla-InsertBlock modelspace insertionPoint name skala-x 1.0 1.0 0) ) ;; ============================================================ ;; METHODE 1: Für rotierte Blöcke (Staustrecken, Separator, Spannstation, Motorstation) ;; X = L * cos(Winkel) ;; Z = -L * sin(Winkel) (negative sin wegen Rotation um Y-Achse) ;; ============================================================ (defun get-block-endpoint-rotated (startpunkt winkel laenge) (setq rad (* winkel (/ pi 180.0))) (list (+ (car startpunkt) (* laenge (cos rad))) (cadr startpunkt) (+ (caddr startpunkt) (* (- (sin rad)) laenge))) ) ;; ============================================================ ;; METHODE 2: Für nicht-rotierte Blöcke (AUS_Element, EIN_Element) ;; Verwendet feste dx/dy/dz Werte ;; ============================================================ ;; ============================================================ ;; METHODE 3: Für Vertikalbögen ;; X aus Tabelle, Z aus Tabelle (nicht BoundingBox!) ;; ============================================================ (defun get-block-endpoint-bogen (startpunkt bogen-x bogen-dz) (list (+ (car startpunkt) bogen-x) (cadr startpunkt) (+ (caddr startpunkt) bogen-dz)) ) ;; ============================================================ ;; Rotation eines Objekts um die Y-Achse (korrigiert) ;; ============================================================ (defun Rotate3D-Y (obj punkt winkel) (setq rad (* winkel (/ pi 180.0))) (setq tx (car punkt) ty (cadr punkt) tz (caddr punkt)) (setq matrix (list (list (cos rad) 0 (sin rad) (- tx (* tx (cos rad)) (* tz (sin rad)))) (list 0 1 0 (- ty ty)) (list (- (sin rad)) 0 (cos rad) (+ tz (* tx (sin rad)) (- (* tz (cos rad))))) (list 0 0 0 1) )) (vla-TransformBy obj (vlax-tmatrix matrix)) ) ;; ============================================================ ;; TEIL 5: WINKELBERECHNUNG (unverändert) ;; ============================================================ (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α nenner winkel mass1 mass2 gueltig) (setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz)) (setq winkel-list '(3 9 12 15 24 36 48) ergebnis-liste '()) (setq cos3 (cos (* 3 (/ pi 180.0))) sin3 (sin (* 3 (/ pi 180.0)))) (princ "\n\n=========================================\n BERECHNUNG FÜR ALLE WINKEL\n=========================================") (princ (strcat "\nΔL = " (rtos deltaL 2 2) " mm\nΔH = " (rtos deltaH 2 2) " mm\nRichtung: " richtung)) (foreach winkel winkel-list (if (= richtung "Auf") (setq mass1 (get-bogen-mass bogen-auf-unten winkel) mass2 (get-bogen-mass bogen-auf-oben winkel) bogen-z1 (caddr mass1) bogen-z2 (caddr mass2)) (setq mass1 (get-bogen-mass-mit-abs bogen-ab-oben winkel) mass2 (get-bogen-mass-mit-abs bogen-ab-unten winkel) bogen-z1 (caddr mass1) bogen-z2 (caddr mass2)) ) (setq bogen-x1 (car mass1) bogen-x2 (car mass2)) (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))) (if (= richtung "Auf") (progn ;; "Auf": L_GF geht bei 3° bergab (-sin3), L_VF geht bei α bergauf (+sinα) ;; Gleichungssystem: cos3·L_GF + cosα·L_VF = A ;; -sin3·L_GF + sinα·L_VF = B (setq B (+ deltaH abs-dz-AUS abs-dz-EIN (- bogen-z1) (- bogen-z2) (* FESTE_HORIZONTAL sin3))) (setq nenner (+ (* cos3 sinα) (* sin3 cosα))) ) (progn ;; "Ab": Beide L_GF und L_VF gehen bergab (+sin3, +sinα) ;; Gleichungssystem: cos3·L_GF + cosα·L_VF = A ;; sin3·L_GF + sinα·L_VF = B (setq B (- deltaH abs-dz-AUS abs-dz-EIN bogen-z1 bogen-z2 (* FESTE_HORIZONTAL sin3))) (setq nenner (- (* cos3 sinα) (* sin3 cosα))) ) ) (if (> (abs nenner) 0.0001) (progn (setq L_GF (/ (- (* A sinα) (* B cosα)) nenner)) (if (= richtung "Auf") (setq L_VF (/ (+ (* B cos3) (* A sin3)) nenner)) (setq L_VF (/ (- (* B cos3) (* A sin3)) nenner)) ) (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=================================================================================\n ERGEBNISTABELLE\n=================================================================================") (princ "\n Winkel L_GF (mm) L_VF (mm) Status\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) "° " (fmt L_GF) " mm " (fmt L_VF) " mm ")) (if gueltig (progn (princ "✓ GÜLTIG") (if (and (null best-winkel) (>= L_GF 0) (>= L_VF 0)) (setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF) ) ) (princ "✗ UNGÜLTIG") ) ) (princ (strcat "\n " (itoa winkel) "° --- --- ✗ FEHLER")) ) ) (princ "\n=================================================================================") (list best-winkel best-L_GF best-L_VF ergebnis-liste) ) ;; ============================================================ ;; TEIL 6: MODULE EINFÜGEN (mit korrigierter Methodenzuordnung) ;; ============================================================ (defun foerderanlage-einfuegen (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt) (setq aktueller-punkt startpunkt) (princ "\n\n=========================================") (princ "\nBeginne mit dem Einfügen der Module...") (princ "\n=========================================") (princ (strcat "\n[START] X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ;; ========================================================== ;; 1. AUS_Element_links ;; ========================================================== (princ "\n\n1/11: AUS_Element_links") (setq blockname (strcat modul-pfad "AUS_Element_links.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (setq aktueller-punkt (list (+ (car aktueller-punkt) aus-dx) (+ (cadr aktueller-punkt) aus-dy) (+ (caddr aktueller-punkt) aus-dz))) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ "\n FEHLER: AUS_Element_links.dwg nicht gefunden.") ) ;; ========================================================== ;; 2. 1. GEFÄLLESTRECKE (L_GF1) ;; ========================================================== (if (> L_GF1 0.1) (progn (princ (strcat "\n\n2/11: Staustrecke (3 Grad, Laenge=" (rtos L_GF1 2 2) " mm)")) (setq blockname (strcat modul-pfad "Staustrecke_SP_1000_mm.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt (/ L_GF1 1000.0))) (Rotate3D-Y block aktueller-punkt 3) (setq aktueller-punkt (get-block-endpoint-rotated aktueller-punkt 3 L_GF1)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ (strcat "\n FEHLER: Blockdatei nicht gefunden: " blockname)) ) ) (princ "\n2/11: (uebersprungen, L_GF1 = 0)") ) ;; ========================================================== ;; 3. SEPARATOR 1 ;; ========================================================== (princ "\n\n3/11: Separator 300mm (3 Grad)") (setq blockname (strcat modul-pfad "Staustrecke_Separator_SP_300_mm.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (Rotate3D-Y block aktueller-punkt 3) (setq aktueller-punkt (get-block-endpoint-rotated aktueller-punkt 3 separator-laenge)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ "\n FEHLER: Separator 1 Datei nicht gefunden.") ) ;; ========================================================== ;; 4. SPANNSTATION ;; ========================================================== (princ "\n\n4/11: Spannstation 500mm (3 Grad)") (setq blockname (strcat modul-pfad "Vario_Spannstation_SP_500mm.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (Rotate3D-Y block aktueller-punkt 3) (setq aktueller-punkt (get-block-endpoint-rotated aktueller-punkt 3 spannstation-laenge)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ "\n FEHLER: Spannstation Datei nicht gefunden.") ) ;; ========================================================== ;; 5. 1. VERTIKALBOGEN (aus Koordinaten-Bibliothek oder Fallback) ;; ========================================================== (if (= richtung "Auf") (progn (setq bogen-lib-name (strcat "Vario_Bogen_auf_" (itoa best-winkel))) (princ (strcat "\n\n5/11: " bogen-lib-name)) (setq bogen-mass (get-bogen-mass bogen-auf-unten best-winkel)) ) (progn (setq bogen-lib-name (strcat "Vario_Bogen_ab_" (itoa best-winkel))) (princ (strcat "\n\n5/11: " bogen-lib-name)) (setq bogen-mass (get-bogen-mass bogen-ab-oben best-winkel)) ) ) ;; Versuche Block aus Koordinaten-Bibliothek zu laden (setq ks-data-1 (insert-bogen-from-lib bogen-lib-name aktueller-punkt)) (if ks-data-1 (progn ;; Endpunkt aus KS_AUS Ursprung ableiten (setq ks-aus-1 (cadr (assoc "KS_AUS" ks-data-1))) (if ks-aus-1 (progn (setq aktueller-punkt (car ks-aus-1)) (princ (strcat "\n Endpunkt (aus KS_AUS): X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (progn (princ "\n WARNUNG: KS_AUS nicht gefunden, verwende Tabellenwerte") (setq bogen-x (car bogen-mass) bogen-dz (caddr bogen-mass)) (setq aktueller-punkt (get-block-endpoint-bogen aktueller-punkt bogen-x bogen-dz)) ) ) ) (progn ;; Fallback: alte Einzelbloecke verwenden (princ "\n Fallback: Verwende Einzel-DWG-Bloecke") (if (= richtung "Auf") (setq blockname (strcat modul-pfad "Vertikalbogen_Auf_" (itoa best-winkel) "_Unten.dwg")) (setq blockname (strcat modul-pfad "Vertikalbogen_Ab_" (itoa best-winkel) "_Oben.dwg")) ) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (setq bogen-x (car bogen-mass) bogen-dz (caddr bogen-mass)) (princ (strcat "\n Tabelle: dx=" (rtos bogen-x 2 2) ", dz=" (rtos bogen-dz 2 2))) (setq aktueller-punkt (get-block-endpoint-bogen aktueller-punkt bogen-x bogen-dz)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ (strcat "\n FEHLER: Bogen-Datei nicht gefunden: " blockname)) ) ) ) ;; ========================================================== ;; 6. VARIABLE STRECKE L_VF ;; ========================================================== (if (> L_VF 0.1) (progn (if (= richtung "Auf") (progn (princ (strcat "\n\n6/11: Steigungsstrecke (" (itoa best-winkel) " Grad, Laenge=" (rtos L_VF 2 2) " mm)")) (setq rot-winkel (- best-winkel)) ) (progn (princ (strcat "\n\n6/11: Gefaellestrecke (" (itoa best-winkel) " Grad, Laenge=" (rtos L_VF 2 2) " mm)")) (setq rot-winkel best-winkel) ) ) (setq blockname (strcat modul-pfad "Staustrecke_SP_1000_mm.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt (/ L_VF 1000.0))) (Rotate3D-Y block aktueller-punkt rot-winkel) (setq aktueller-punkt (get-block-endpoint-rotated aktueller-punkt rot-winkel L_VF)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ (strcat "\n FEHLER: Blockdatei nicht gefunden: " blockname)) ) ) (princ "\n6/11: (L_VF = 0, uebersprungen)") ) ;; ========================================================== ;; 7. 2. VERTIKALBOGEN (aus Koordinaten-Bibliothek oder Fallback) ;; ========================================================== (if (= richtung "Auf") (progn (setq bogen-lib-name (strcat "Vario_Bogen_auf_" (itoa best-winkel))) (princ (strcat "\n\n7/11: " bogen-lib-name " (2. Bogen)")) (setq bogen-mass (get-bogen-mass bogen-auf-oben best-winkel)) ) (progn (setq bogen-lib-name (strcat "Vario_Bogen_ab_" (itoa best-winkel))) (princ (strcat "\n\n7/11: " bogen-lib-name " (2. Bogen)")) (setq bogen-mass (get-bogen-mass bogen-ab-unten best-winkel)) ) ) ;; Versuche Block aus Koordinaten-Bibliothek zu laden (setq ks-data-2 (insert-bogen-from-lib bogen-lib-name aktueller-punkt)) (if ks-data-2 (progn ;; Endpunkt aus KS_AUS Ursprung ableiten (setq ks-aus-2 (cadr (assoc "KS_AUS" ks-data-2))) (if ks-aus-2 (progn (setq aktueller-punkt (car ks-aus-2)) (princ (strcat "\n Endpunkt (aus KS_AUS): X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (progn (princ "\n WARNUNG: KS_AUS nicht gefunden, verwende Tabellenwerte") (setq bogen-x (car bogen-mass) bogen-dz (caddr bogen-mass)) (setq aktueller-punkt (get-block-endpoint-bogen aktueller-punkt bogen-x bogen-dz)) ) ) ) (progn ;; Fallback: alte Einzelbloecke verwenden (princ "\n Fallback: Verwende Einzel-DWG-Bloecke") (if (= richtung "Auf") (setq blockname (strcat modul-pfad "Vertikalbogen_Auf_" (itoa best-winkel) "_Oben.dwg")) (setq blockname (strcat modul-pfad "Vertikalbogen_Ab_" (itoa best-winkel) "_Unten.dwg")) ) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (setq bogen-x (car bogen-mass) bogen-dz (caddr bogen-mass)) (princ (strcat "\n Tabelle: dx=" (rtos bogen-x 2 2) ", dz=" (rtos bogen-dz 2 2))) (setq aktueller-punkt (get-block-endpoint-bogen aktueller-punkt bogen-x bogen-dz)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ (strcat "\n FEHLER: Bogen-Datei nicht gefunden: " blockname)) ) ) ) ;; ========================================================== ;; 8. MOTORSTATION ;; ========================================================== (princ "\n\n8/11: Motorstation 500mm (3 Grad)") (setq blockname (strcat modul-pfad "Vario_Motorstation_SP_500mm.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (Rotate3D-Y block aktueller-punkt 3) (setq aktueller-punkt (get-block-endpoint-rotated aktueller-punkt 3 motorstation-laenge)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ "\n FEHLER: Motorstation Datei nicht gefunden.") ) ;; ========================================================== ;; 9. 2. GEFÄLLESTRECKE (L_GF2) ;; ========================================================== (if (> L_GF2 0.1) (progn (princ (strcat "\n\n9/11: Staustrecke (3 Grad, Laenge=" (rtos L_GF2 2 2) " mm)")) (setq blockname (strcat modul-pfad "Staustrecke_SP_1000_mm.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt (/ L_GF2 1000.0))) (Rotate3D-Y block aktueller-punkt 3) (setq aktueller-punkt (get-block-endpoint-rotated aktueller-punkt 3 L_GF2)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ (strcat "\n FEHLER: Blockdatei nicht gefunden: " blockname)) ) ) (princ "\n9/11: (uebersprungen, L_GF2 = 0)") ) ;; ========================================================== ;; 10. SEPARATOR 2 ;; ========================================================== (princ "\n\n10/11: Separator 300mm (3 Grad)") (setq blockname (strcat modul-pfad "Staustrecke_Separator_SP_300_mm.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (Rotate3D-Y block aktueller-punkt 3) (setq aktueller-punkt (get-block-endpoint-rotated aktueller-punkt 3 separator-laenge)) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ "\n FEHLER: Separator 2 Datei nicht gefunden.") ) ;; ========================================================== ;; 11. EIN_Element_links ;; ========================================================== (princ "\n\n11/11: EIN_Element_links") (setq blockname (strcat modul-pfad "EIN_Element_links.dwg")) (if (findfile blockname) (progn (princ (strcat "\n Einfuegen bei: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) (setq block (InsertBlock blockname aktueller-punkt 1.0)) (setq aktueller-punkt (list (+ (car aktueller-punkt) ein-dx) (+ (cadr aktueller-punkt) ein-dy) (+ (caddr aktueller-punkt) ein-dz))) (princ (strcat "\n Endpunkt: X=" (rtos (car aktueller-punkt) 2 2) ", Y=" (rtos (cadr aktueller-punkt) 2 2) ", Z=" (rtos (caddr aktueller-punkt) 2 2))) ) (princ "\n FEHLER: EIN_Element_links Datei nicht gefunden.") ) (princ "\n\n=========================================") (princ "\n>>> FERTIG! Förderanlage erfolgreich erstellt! <<<") (princ "\n=========================================") ) ;; ============================================================ ;; TEIL 7: HAUPTFUNKTION ;; ============================================================ (defun c:FOERDERANLAGE ( / eingabe-modus startpunkt endpunkt differenz deltaL deltaH deltaY richtung ergebnis best-winkel L_GF L_GF1 L_GF2 L_VF ergebnis-liste antwort verteilung-modus) (princ "\n=========================================") (princ "\n FÖRDERANLAGE GENERATOR v24.3") (princ "\n=========================================") (princ "\n\nEingabemodus wählen:") (princ "\n 1 - Punkte auswählen (in der Zeichnung)") (princ "\n 2 - Werte manuell eingeben") (setq antwort (getstring "\nIhre Wahl (1/2): ")) (cond ((= antwort "1") (setq eingabe-modus "Punkt")) ((= antwort "2") (setq eingabe-modus "Wert")) (t (setq eingabe-modus "Punkt") (princ "\nUngültige Eingabe, Modus 'Punkte auswählen'")) ) (if (= eingabe-modus "Punkt") (progn (princ "\n\n>>> MODUS: Punkte auswählen <<<") (princ "\nWählen Sie die Einfügepunkte der Elemente.\n") (setq startpunkt (getpoint "\n1. START-PUNKT (Eingang des AUS_Elements): ")) (if (null startpunkt) (progn (alert "Kein Startpunkt!") (exit))) (setq endpunkt (getpoint "\n2. END-PUNKT (Ausgang des EIN_Elements): ")) (if (null endpunkt) (progn (alert "Kein Endpunkt!") (exit))) (setq differenz (punkt-differenz startpunkt endpunkt)) (setq deltaL (abs (car differenz)) deltaY (cadr differenz) deltaH (caddr differenz)) (princ "\n\n=========================================") (princ (strcat "\nGemessene Werte (Distanz zwischen den Punkten):\n ΔL = " (rtos deltaL 2 2) " mm\n ΔH = " (rtos deltaH 2 2) " mm")) (if (> (abs deltaY) 50) (princ (strcat "\n ⚠ WARNUNG: Seitlicher Versatz ΔY = " (rtos deltaY 2 2) " mm!"))) (if (>= deltaH 0) (progn (setq richtung "Auf") (princ "\n\nFörderrichtung: AUF (nach oben)")) (progn (setq richtung "Ab") (setq deltaH (abs deltaH)) (princ "\n\nFörderrichtung: AB (nach unten)")) ) (setq startpunkt-fuer-einfuegen startpunkt) ) (progn (princ "\n\n>>> MODUS: Manuelle Werteingabe <<<") (setq deltaL (getreal "\nHorizontale Distanz ΔL (mm): ")) (if (null deltaL) (setq deltaL 15000)) (setq deltaH (getreal "\nHöhendifferenz |ΔH| (mm): ")) (if (null deltaH) (setq deltaH 3000)) (princ "\nFörderrichtung wählen:\n 1 - AUF (nach oben)\n 2 - AB (nach unten)") (setq antwort (getstring "\nIhre Wahl (1/2): ")) (if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf")) (setq startpunkt-fuer-einfuegen (getpoint "\nStartpunkt für AUS_Element wählen: ")) (if (null startpunkt-fuer-einfuegen) (setq startpunkt-fuer-einfuegen '(0 0 0))) ) ) (setq ergebnis (berechne-alle-winkel deltaL deltaH richtung)) (setq best-winkel (car ergebnis) L_GF (cadr ergebnis) L_VF (caddr ergebnis)) (if (or (null best-winkel) (null L_GF) (null L_VF) (<= L_GF 0) (<= L_VF 0)) (progn (alert "Kein passender Winkel gefunden!\n\nBitte andere Werte versuchen.") (exit)) ) (princ "\n\n=========================================") (princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) "°")) (princ (strcat "\n>>> L_GF (gesamt): " (rtos L_GF 2 2) " mm")) (princ (strcat "\n>>> L_VF: " (rtos L_VF 2 2) " mm")) (princ "\n=========================================") ;; Verteilung der Gefaellestrecken (L_GF1 vorne, L_GF2 hinten) (princ "\n\nVerteilung der Gefaellestrecken (vorne/hinten):") (princ "\n 1 - Gleichmaessig (L_GF1 = L_GF2 = L_GF/2)") (princ "\n 2 - Vorne Minimum, hinten Rest") (princ "\n 3 - Hinten Minimum, vorne Rest") (princ "\n 4 - Eigene Werte eingeben") (setq verteilung-modus (getstring "\nIhre Wahl (1/2/3/4) [1]: ")) (if (= verteilung-modus "") (setq verteilung-modus "1")) (cond ((= verteilung-modus "1") (setq L_GF1 (/ L_GF 2.0)) (setq L_GF2 (/ L_GF 2.0)) ) ((= verteilung-modus "2") (setq L_GF1 staustrecke-basis) (setq L_GF2 (- L_GF staustrecke-basis)) (if (< L_GF2 0) (setq L_GF2 0)) ) ((= verteilung-modus "3") (setq L_GF2 staustrecke-basis) (setq L_GF1 (- L_GF staustrecke-basis)) (if (< L_GF1 0) (setq L_GF1 0)) ) ((= verteilung-modus "4") (setq L_GF1 (getreal (strcat "\nL_GF1 vorne (mm) [" (rtos (/ L_GF 2.0) 2 2) "]: "))) (if (null L_GF1) (setq L_GF1 (/ L_GF 2.0))) (setq L_GF2 (- L_GF L_GF1)) (if (< L_GF2 0) (setq L_GF2 0)) (princ (strcat "\n L_GF2 hinten (berechnet): " (rtos L_GF2 2 2) " mm")) ) (t (setq L_GF1 (/ L_GF 2.0)) (setq L_GF2 (/ L_GF 2.0)) ) ) (princ (strcat "\n\n>>> L_GF1 (vorne): " (rtos L_GF1 2 2) " mm")) (princ (strcat "\n>>> L_GF2 (hinten): " (rtos L_GF2 2 2) " mm")) (princ "\n\nMöchten Sie die Förderanlage einfügen?\n 1 - Ja, Module einfügen\n 2 - Nein, abbrechen") (setq antwort (getstring "\nIhre Wahl (1/2): ")) (if (= antwort "1") (foerderanlage-einfuegen deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt-fuer-einfuegen) (princ "\nVorgang abgebrochen.") ) (princ) ) ;; ============================================================ ;; TEIL 8: FOERDERTEST - Automatischer Test ohne Benutzereingabe ;; Mit tabellarischer Zusammenfassung am Ende ;; ============================================================ (defun c:FOERDERTEST ( / deltaL deltaH richtung ergebnis best-winkel L_GF L_VF dateiname y-offset hoehen-liste idx anz-gebaut anz-nicht-gebaut result-pfad erfolgsquote zusammenfassung-liste) ;; ← Neue Liste für Zusammenfassung (setq deltaL 7000) (setq hoehen-liste '(0 1000 2000 3000 4000 5000)) (setq y-offset 0) (setq idx 0) (setq zusammenfassung-liste '()) ;; ← Zusammenfassungs-Liste (setq anz-gebaut 0) (setq anz-nicht-gebaut 0) (princ "\n") (princ "\n╔══════════════════════════════════════════════════════════════════════════════╗") (princ "\n║ FÖRDERTEST - PRODUKTIONSPROTOKOLL ║") (princ "\n╠══════════════════════════════════════════════════════════════════════════════╣") (princ (strcat "\n║ Distanz ΔL = " (rtos deltaL 2 0) " mm ║")) (princ "\n║ Höhenstufen: 0, 1000, 2000, 3000, 4000, 5000 mm ║") (princ "\n║ Richtungen: Auf + Ab ║") (princ "\n╠══════════════════════════════════════════════════════════════════════════════╣") (princ "\n║ Nr. Richtung ΔH (mm) Status Winkel L_GF (mm) L_VF (mm) ║") (princ "\n╠══════════════════════════════════════════════════════════════════════════════╣") ;; ========================================================== ;; TEIL 1: Aufwärts-Tests (6 Förderer) ;; ========================================================== (foreach deltaH hoehen-liste (setq idx (1+ idx)) (setq richtung "Auf") (setq ergebnis (berechne-alle-winkel deltaL deltaH richtung)) (setq best-winkel (car ergebnis)) (setq L_GF (cadr ergebnis)) (setq L_VF (caddr ergebnis)) (if (and best-winkel L_GF L_VF (> L_GF 0) (> L_VF 0)) (progn (setq anz-gebaut (1+ anz-gebaut)) (princ (strcat "\n║ " (itoa idx) " " (if (< idx 10) " " "") "Auf " (rtos deltaH 4 0) " " "✓ GEBAUT " (itoa best-winkel) "° " (rtos L_GF 2 1) " " (rtos L_VF 2 1) " ║")) (foerderanlage-einfuegen deltaL deltaH richtung best-winkel (/ L_GF 2.0) (/ L_GF 2.0) L_VF (list 0 y-offset 0)) ;; ⬇️⬇️⬇️ LISTE BEFÜLLEN ⬇️⬇️⬇️ (setq zusammenfassung-liste (cons (list idx richtung deltaH "GEBAUT" best-winkel L_GF L_VF) zusammenfassung-liste)) ) (progn (setq anz-nicht-gebaut (1+ anz-nicht-gebaut)) (princ (strcat "\n║ " (itoa idx) " " (if (< idx 10) " " "") "Auf " (rtos deltaH 4 0) " " "✗ NICHT " "--- " "--- " "--- ║")) (cond ((and (<= L_GF 0) (<= L_VF 0)) (princ "\n║ → Grund: L_GF und L_VF sind negativ (Strecke zu kurz) ║")) ((<= L_GF 0) (princ "\n║ → Grund: L_GF ist negativ (Gefällestrecke zu kurz) ║")) ((<= L_VF 0) (princ "\n║ → Grund: L_VF ist negativ (keine passende Steigung möglich) ║")) ((null best-winkel) (princ "\n║ → Grund: Kein passender Winkel (Höhendifferenz zu groß/klein) ║")) (t (princ "\n║ → Grund: Unbekannter Fehler in der Berechnung ║")) ) ;; ⬇️⬇️⬇️ LISTE BEFÜLLEN ⬇️⬇️⬇️ (setq zusammenfassung-liste (cons (list idx richtung deltaH "NICHT_GEBAUT" nil nil nil) zusammenfassung-liste)) ) ) (setq y-offset (- y-offset 200)) ) ;; ========================================================== ;; TEIL 2: Abwärts-Tests (6 Förderer) ;; ========================================================== (foreach deltaH hoehen-liste (setq idx (1+ idx)) (setq richtung "Ab") (if (< deltaH 1) (progn ;; deltaH = 0 bei Abwärts ist prinzipiell unmöglich (setq anz-nicht-gebaut (1+ anz-nicht-gebaut)) (princ (strcat "\n║ " (itoa idx) " " (if (< idx 10) " " "") "Ab " (rtos deltaH 4 0) " " "✗ NICHT " "--- " "--- " "--- ║")) (princ "\n║ → Grund: Bei Richtung 'Ab' mit ΔH=0 ist aus geometrischen Gründen ║") (princ "\n║ keine Förderanlage möglich (immer negative Netto-Höhe) ║") ;; ⬇️⬇️⬇️ LISTE BEFÜLLEN ⬇️⬇️⬇️ (setq zusammenfassung-liste (cons (list idx richtung deltaH "GEOMETRISCH_UNMOEGLICH" nil nil nil) zusammenfassung-liste)) ) (progn (setq ergebnis (berechne-alle-winkel deltaL deltaH richtung)) (setq best-winkel (car ergebnis)) (setq L_GF (cadr ergebnis)) (setq L_VF (caddr ergebnis)) (if (and best-winkel L_GF L_VF (> L_GF 0) (> L_VF 0)) (progn ;; Förderer kann gebaut werden (setq anz-gebaut (1+ anz-gebaut)) (princ (strcat "\n║ " (itoa idx) " " (if (< idx 10) " " "") "Ab " (rtos deltaH 4 0) " " "✓ GEBAUT " (itoa best-winkel) "° " (rtos L_GF 2 1) " " (rtos L_VF 2 1) " ║")) ;; Förderanlage tatsächlich einfügen (foerderanlage-einfuegen deltaL deltaH richtung best-winkel (/ L_GF 2.0) (/ L_GF 2.0) L_VF (list 0 y-offset 0)) ;; ⬇️⬇️⬇️ LISTE BEFÜLLEN ⬇️⬇️⬇️ (setq zusammenfassung-liste (cons (list idx richtung deltaH "GEBAUT" best-winkel L_GF L_VF) zusammenfassung-liste)) ) (progn ;; Förderer kann NICHT gebaut werden (setq anz-nicht-gebaut (1+ anz-nicht-gebaut)) (princ (strcat "\n║ " (itoa idx) " " (if (< idx 10) " " "") "Ab " (rtos deltaH 4 0) " " "✗ NICHT " "--- " "--- " "--- ║")) ;; Fehleranalyse (cond ((and (<= L_GF 0) (<= L_VF 0)) (princ "\n║ → Grund: L_GF und L_VF sind negativ (Strecke zu kurz) ║")) ((<= L_GF 0) (princ "\n║ → Grund: L_GF ist negativ (Gefällestrecke zu kurz) ║")) ((<= L_VF 0) (princ "\n║ → Grund: L_VF ist negativ (Höhendifferenz zu klein für diesen Weg)║")) ((null best-winkel) (princ "\n║ → Grund: Kein passender Winkel (Höhendifferenz zu groß) ║")) (t (princ "\n║ → Grund: Unbekannter Fehler in der Berechnung ║")) ) ;; ⬇️⬇️⬇️ LISTE BEFÜLLEN ⬇️⬇️⬇️ (setq zusammenfassung-liste (cons (list idx richtung deltaH "NICHT_GEBAUT" nil nil nil) zusammenfassung-liste)) ) ) ) ) (setq y-offset (- y-offset 200)) ) ;; ========================================================== ;; TEIL 3: EINFACHE ZUSAMMENFASSUNG (OHNE RAHMEN) ;; ========================================================== (princ "\n\n================================================================================") (princ "\n ZUSAMMENFASSUNG") (princ (strcat "\n ΔL = " (rtos deltaL 2 0) " mm")) (princ "\n================================================================================") (foreach item (reverse zusammenfassung-liste) (setq nr (car item)) (setq richtung (cadr item)) (setq deltaH_val (caddr item)) (setq status (cadddr item)) (setq winkel (car (cddddr item))) (setq L_GF_val (cadr (cddddr item))) (setq L_VF_val (caddr (cddddr item))) (cond ((= status "GEBAUT") (princ (strcat "\n " (itoa nr) ". " richtung (if (= richtung "Auf") " " " ") (rtos deltaH_val 2 0) " mm " (itoa winkel) "° " (rtos L_GF_val 2 2) " mm " (rtos L_VF_val 2 2) " mm GEBAUT"))) ((= status "GEOMETRISCH_UNMOEGLICH") (princ (strcat "\n " (itoa nr) ". " richtung (if (= richtung "Auf") " " " ") (rtos deltaH_val 2 0) " mm " "--- " "--- mm " "--- mm GEOMETRISCH UNMOEGLICH"))) (t (princ (strcat "\n " (itoa nr) ". " richtung (if (= richtung "Auf") " " " ") (rtos deltaH_val 2 0) " mm " "--- " "--- mm " "--- mm NICHT GEBAUT"))) ) ) (princ "\n\n================================================================================") (princ (strcat "\n Erfolgreich gebaut: " (itoa anz-gebaut) " von " (itoa idx))) (princ (strcat "\n Erfolgsquote: " (rtos (/ (* anz-gebaut 100.0) idx) 2 1) "%")) (princ "\n================================================================================") (princ "\n\n Erklaerung:") (princ "\n ----------") (princ "\n ✓ GEBAUT:") (princ "\n - Auf, ΔH=0 → L_VF > 0 kompensiert 3°-Gefaellestrecken") (princ "\n - Auf, ΔH>0 → Normalfall") (princ "\n - Ab, ΔH>=1000 → Normalfall") (princ "\n") (princ "\n ✗ NICHT GEBAUT:") (princ "\n - Ab, ΔH=0 → Geometrisch unmoeglich (Netto-Hoehe immer negativ)") (princ "\n - Auf, ΔH=5000 → 48° Steigung reicht nicht aus (L_VF negativ)") (princ "\n - Ab, ΔH=5000 → 48° Gefaelle reicht nicht aus") (princ "\n================================================================================") ;; Datei speichern (if (getenv "DXFM_RESULTS") (setq result-pfad (getenv "DXFM_RESULTS")) (setq result-pfad (strcat (getenv "DXFM_BLOCKS") "../results")) ) ;; Dateiname: datum-HHMM.dxf (if (getenv "DXFM_RESULTS") (setq result-pfad (getenv "DXFM_RESULTS")) (setq result-pfad (strcat modul-pfad "../results")) ) (setq dateiname (strcat result-pfad "/" (menucmd "M=$(edtime,$(getvar,date),YYYYMODD-HHmm)") ".dxf")) (princ (strcat "\n\nSpeichere als: " dateiname)) (command "_.DXFOUT" dateiname "V" "2018" "16") (princ "\n\n>>> FOERDERTEST abgeschlossen (12 Foerderer)! <<<") (princ) ) ;; ============================================================ ;; START ;; ============================================================ (princ "\n=========================================") (princ "\n>>> FOERDERANLAGE GENERATOR v24.4 geladen <<<") (princ "\n>>> Befehle: FOERDERANLAGE, FOERDERTEST <<<") (princ "\n>>> Z-Berechnung: Trigonometrisch + Tabellenwerte <<<") (princ "\n=========================================") (princ)