1289 lines
56 KiB
Common Lisp
1289 lines
56 KiB
Common Lisp
;; ============================================================
|
||
;; 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 fuer dynamische Bogen-Tabellen
|
||
;; t = dynamisch aus KS_EIN/KS_AUS der Koordinaten-Bibliothek
|
||
;; nil = feste, hartkodierte Werte (Fallback)
|
||
;; ============================================================
|
||
(setq use-dynamic-bbox nil) ;; 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
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 4b: KS_EIN / KS_AUS KOORDINATEN EXTRAHIEREN
|
||
;; (vor create-bogen-table, da dort benoetigt)
|
||
;; ============================================================
|
||
|
||
;; 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
|
||
)
|
||
|
||
;; ============================================================
|
||
;; Funktion zum Erstellen der Bogen-Tabellen dynamisch
|
||
;; Verwendet KS_EIN/KS_AUS aus der Koordinaten-Bibliothek
|
||
;; ============================================================
|
||
(defun create-bogen-table (richtung unten-oben / winkel-list table
|
||
bogen-name full-name block-obj ks-data
|
||
ks-ein-data ks-aus-data ein-origin aus-origin
|
||
dx dz richtung-klein)
|
||
(setq winkel-list '(3 9 12 15 24 36 48))
|
||
(setq table '())
|
||
;; Richtung kleingeschrieben fuer Blocknamen (Vario_Bogen_auf_3°)
|
||
(setq richtung-klein (if (= richtung "Auf") "auf" "ab"))
|
||
|
||
;; Koordinaten-Bibliothek laden
|
||
(load-koordinaten-lib)
|
||
|
||
(foreach winkel winkel-list
|
||
(setq bogen-name (strcat "Vario_Bogen_" richtung-klein "_" (itoa winkel)))
|
||
(setq full-name (strcat bogen-name grad-zeichen))
|
||
|
||
(if (tblsearch "BLOCK" full-name)
|
||
(progn
|
||
;; Block temporaer einfuegen bei (0,0,0)
|
||
(setq block-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
full-name 1.0 1.0 1.0 0))
|
||
;; KS_EIN und KS_AUS extrahieren
|
||
(setq ks-data (extract-ks-from-block block-obj))
|
||
;; Block loeschen
|
||
(vla-Delete block-obj)
|
||
|
||
(setq ks-ein-data (cadr (assoc "KS_EIN" ks-data)))
|
||
(setq ks-aus-data (cadr (assoc "KS_AUS" ks-data)))
|
||
|
||
(if (and ks-ein-data ks-aus-data)
|
||
(progn
|
||
(setq ein-origin (car ks-ein-data))
|
||
(setq aus-origin (car ks-aus-data))
|
||
;; Offset: KS_AUS - KS_EIN
|
||
(setq dx (- (car aus-origin) (car ein-origin)))
|
||
(setq dz (- (caddr aus-origin) (caddr ein-origin)))
|
||
(princ (strcat "\n " full-name ": dx=" (rtos dx 2 2) " dz=" (rtos dz 2 2)))
|
||
(setq table (cons (list winkel dx 0 dz) table))
|
||
)
|
||
(princ (strcat "\nWARNUNG: KS_EIN/KS_AUS nicht gefunden in " full-name))
|
||
)
|
||
)
|
||
(princ (strcat "\nWARNUNG: Block " full-name " nicht in Bibliothek"))
|
||
)
|
||
)
|
||
(reverse table)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 3: BOGEN-MASSE (Verzweigung basierend auf Flag)
|
||
;; ============================================================
|
||
(if use-dynamic-bbox
|
||
(progn
|
||
(princ "\nVerwende dynamische KS_EIN/KS_AUS-Berechnung fuer 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 fuer 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 wurde nach oben verschoben, vor create-bogen-table)
|
||
|
||
;; 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) |