Files
dxfmakros/Lisp/VarioFoerderer.lsp
T

700 lines
31 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.
;; ============================================================
;; 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! Verwende Standardpfad.")
(setq modul-pfad "c:/10-Develop/gitrepos/dxfmakros/Blocks/")
)
)
(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 -446.42)
(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) "---")
)
;; ============================================================
;; 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)))
(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))
(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_GF L_VF startpunkt)
(setq aktueller-punkt startpunkt)
(setq L_GF1 (/ L_GF 2))
(setq L_GF2 (/ L_GF 2))
(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 (X und Z aus Tabelle)
;; ==========================================================
(if (= richtung "Auf")
(progn
(princ (strcat "\n\n5/11: Vertikalbogen_Auf_" (itoa best-winkel) "_Unten"))
(setq blockname (strcat modul-pfad "Vertikalbogen_Auf_" (itoa best-winkel) "_Unten.dwg"))
(setq bogen-mass (get-bogen-mass bogen-auf-unten best-winkel))
)
(progn
(princ (strcat "\n\n5/11: Vertikalbogen_Ab_" (itoa best-winkel) "_Oben"))
(setq blockname (strcat modul-pfad "Vertikalbogen_Ab_" (itoa best-winkel) "_Oben.dwg"))
(setq bogen-mass (get-bogen-mass bogen-ab-oben best-winkel))
)
)
(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))
(setq 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 (X und Z aus Tabelle)
;; ==========================================================
(if (= richtung "Auf")
(progn
(princ (strcat "\n\n7/11: Vertikalbogen_Auf_" (itoa best-winkel) "_Oben"))
(setq blockname (strcat modul-pfad "Vertikalbogen_Auf_" (itoa best-winkel) "_Oben.dwg"))
(setq bogen-mass (get-bogen-mass bogen-auf-oben best-winkel))
)
(progn
(princ (strcat "\n\n7/11: Vertikalbogen_Ab_" (itoa best-winkel) "_Unten"))
(setq blockname (strcat modul-pfad "Vertikalbogen_Ab_" (itoa best-winkel) "_Unten.dwg"))
(setq bogen-mass (get-bogen-mass bogen-ab-unten best-winkel))
)
)
(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))
(setq 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_VF ergebnis-liste antwort)
(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_GF1 = L_GF2 = " (rtos (/ L_GF 2) 2 2) " mm"))
(princ (strcat "\n>>> L_VF: " (rtos L_VF 2 2) " mm"))
(princ "\n=========================================")
(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_GF L_VF startpunkt-fuer-einfuegen)
(princ "\nVorgang abgebrochen.")
)
(princ)
)
;; ============================================================
;; TEIL 8: FOERDERTEST - Automatischer Test ohne Benutzereingabe
;; Distanz=6000, Hoehe=2000, Richtung=Auf, Start=0/0/0
;; Speichert als datum-HHMM.dxf
;; ============================================================
(defun c:FOERDERTEST ( / deltaL deltaH richtung ergebnis
best-winkel L_GF L_VF dateiname)
(setq deltaL 6000)
(setq deltaH 2000)
(setq richtung "Auf")
(princ "\n=========================================")
(princ "\n FOERDERTEST (automatisch)")
(princ "\n=========================================")
(princ (strcat "\nDistanz: " (rtos deltaL 2 2) " mm"))
(princ (strcat "\nHoehe: " (rtos deltaH 2 2) " mm"))
(princ (strcat "\nRichtung: " richtung))
(princ "\nStartpunkt: 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 (princ "\nFEHLER: Kein passender Winkel gefunden!") (princ))
(progn
(princ (strcat "\n\nGewaehlter Winkel: " (itoa best-winkel) " Grad"))
(princ (strcat "\nL_GF (gesamt): " (rtos L_GF 2 2) " mm"))
(princ (strcat "\nL_GF1 = L_GF2 = " (rtos (/ L_GF 2) 2 2) " mm"))
(princ (strcat "\nL_VF: " (rtos L_VF 2 2) " mm"))
;; Foerderanlage einfuegen bei 0,0,0
(foerderanlage-einfuegen deltaL deltaH richtung best-winkel L_GF L_VF '(0 0 0))
;; 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! <<<")
)
)
(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)