865 lines
34 KiB
Common Lisp
865 lines
34 KiB
Common Lisp
;; ============================================================
|
||
;; FÖRDERANLAGE GENERATOR für BricsCAD Pro
|
||
;; Version: 25.0 (Komplett bibliotheksbasiert, keine Fallbacks)
|
||
;; 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
|
||
(if (getenv "DXFM_DATA")
|
||
(setq koordinaten-lib (strcat (getenv "DXFM_DATA") "/block_libraries/ils_library.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: GLOBALE VARIABLEN (werden aus Bibliothek befüllt)
|
||
;; ============================================================
|
||
(setq aus-dx nil aus-dy nil aus-dz nil)
|
||
(setq ein-dx nil ein-dy nil ein-dz nil)
|
||
(setq separator-laenge nil umlenk-laenge nil motorstation-laenge nil)
|
||
(setq staustrecke-basis 1000)
|
||
(setq FESTE_HORIZONTAL 1600)
|
||
|
||
;; Bogen-Tabellen (werden aus Bibliothek befüllt)
|
||
(setq bogen-auf '()) ;; Format: ((winkel dx dy dz) ...)
|
||
(setq bogen-ab '())
|
||
|
||
;; Cache für geladene Daten
|
||
(setq *lib-initialized* nil)
|
||
(setq *bogen-cache-loaded* nil)
|
||
(setq *modul-cache* nil)
|
||
|
||
;; ============================================================
|
||
;; TEIL 3: HILFSFUNKTIONEN
|
||
;; ============================================================
|
||
(defun vec-length (v)
|
||
(sqrt (+ (* (car v) (car v)) (* (cadr v) (cadr v)) (* (caddr v) (caddr v))))
|
||
)
|
||
|
||
(defun ks-line-axis (len)
|
||
(cond
|
||
((and (> len 0.5) (< len 1.5)) "X") ;; 1.0
|
||
((and (> len 99) (< len 101)) "X") ;; 100.0
|
||
((and (> len 1.5) (< len 2.5)) "Y") ;; 2.0
|
||
((and (> len 2.5) (< len 3.5)) "Z") ;; 3.0
|
||
(t nil)
|
||
)
|
||
)
|
||
|
||
(defun fmt (x)
|
||
(if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---")
|
||
)
|
||
|
||
(defun punkt-differenz (p1 p2)
|
||
(list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1)))
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 4: KS_EIN/KS_AUS EXTRAKTION (KERN-FUNKTION)
|
||
;; ============================================================
|
||
|
||
;; Grad-Zeichen für Blocknamen
|
||
(setq grad-zeichen (chr 176))
|
||
|
||
;; Extrahiert KS_EIN und KS_AUS aus einem Block
|
||
;; Rückgabe: (("KS_EIN" (origin x-end y-end z-end))
|
||
;; ("KS_AUS" (origin x-end y-end z-end)))
|
||
(defun extract-ks-from-block (block-obj / sub-entities sub-obj ks-results
|
||
ks-ref inner-entities inner-obj origin x-end y-end z-end
|
||
line-start line-end axis line-len line-vec)
|
||
(dbgf "extract-ks-from-block")
|
||
(setq ks-results '())
|
||
|
||
;; Block explodieren
|
||
(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 explodieren
|
||
(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))
|
||
|
||
(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))
|
||
)
|
||
)
|
||
)
|
||
(if (not (vlax-erased-p inner-obj)) (vla-Delete inner-obj))
|
||
)
|
||
|
||
;; Ergebnis speichern
|
||
(if (and origin x-end y-end z-end)
|
||
(setq ks-results (cons (list ks-ref (list origin x-end y-end z-end)) ks-results))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Aufräumen
|
||
(foreach sub-obj sub-entities
|
||
(if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj))
|
||
)
|
||
|
||
(dbgreturn ks-results)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 5: PUNKTE-AUSWAHL MIT Z-HÖHE (HIER EINFÜGEN!)
|
||
;; ============================================================
|
||
(defun get-3d-point-from-object (msg / ent obj pt variant)
|
||
(dbgf "get-3d-point-from-object")
|
||
(princ msg)
|
||
(princ "\n >> Objekt (Block) wählen: ")
|
||
(setq ent (entsel))
|
||
(if ent
|
||
(progn
|
||
(setq obj (vlax-ename->vla-object (car ent)))
|
||
|
||
;; Versuche Block-Einfügepunkt zu bekommen
|
||
(if (vlax-property-available-p obj 'InsertionPoint)
|
||
(progn
|
||
;; In BricsCAD: InsertionPoint ist ein VARIANT, kein Safearray!
|
||
(setq variant (vla-get-InsertionPoint obj))
|
||
;; Variant in Safearray umwandeln
|
||
(setq pt (vlax-safearray->list (vlax-variant-value variant)))
|
||
(princ (strcat "\n ✓ Block-Einfügepunkt (mit Z):"
|
||
"\n X = " (rtos (car pt) 2 3)
|
||
"\n Y = " (rtos (cadr pt) 2 3)
|
||
"\n Z = " (rtos (caddr pt) 2 3)))
|
||
)
|
||
(progn
|
||
;; Kein Block: Verwende angeklickten Punkt
|
||
(setq pt (cadr ent))
|
||
(princ (strcat "\n ✓ Punkt auf Objekt: Z = " (rtos (caddr pt) 2 2) " mm"))
|
||
)
|
||
)
|
||
)
|
||
(progn
|
||
(princ "\n Kein Objekt gewählt.")
|
||
(setq pt nil)
|
||
)
|
||
)
|
||
(dbgreturn pt)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 6: BIBLIOTHEK LADEN & MAßE EXTRAHIEREN
|
||
;; ============================================================
|
||
|
||
;; Lädt die Bibliothek und extrahiert ALLE benötigten Maße
|
||
(defun init-bibliothek ( / temp-obj bogen-winkel)
|
||
(dbgf "init-bibliothek")
|
||
|
||
(if *lib-initialized*
|
||
(progn
|
||
(princ "\n Bibliothek bereits initialisiert.")
|
||
(dbgreturn t)
|
||
)
|
||
(progn
|
||
(princ "\n Lade Blockdefinitionen aus Bibliothek...")
|
||
|
||
(if (findfile koordinaten-lib)
|
||
(progn
|
||
(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.")
|
||
|
||
;; === AUS_ELEMENT Maße extrahieren ===
|
||
(princ "\n Extrahiere AUS_Element Masse...")
|
||
(if (tblsearch "BLOCK" "_3D_AS_90_links")
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
"_3D_AS_90_links" 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(vla-Delete temp-obj)
|
||
(setq ks-ein-pos nil ks-aus-pos nil)
|
||
(foreach item ks-data
|
||
(if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
|
||
(if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
|
||
)
|
||
(if (and ks-ein-pos ks-aus-pos)
|
||
(progn
|
||
(setq aus-dx (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
|
||
(setq aus-dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
|
||
(setq aus-dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
|
||
(princ (strcat "\n AUS_Element: dx=" (rtos aus-dx 2 0) ", dz=" (rtos aus-dz 2 0)))
|
||
)
|
||
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im AUS_Element!")
|
||
)
|
||
)
|
||
(princ "\n FEHLER: Block _3D_AS_90_links nicht gefunden!")
|
||
)
|
||
|
||
;; === EIN_ELEMENT Maße extrahieren ===
|
||
(princ "\n Extrahiere EIN_Element Masse...")
|
||
(if (tblsearch "BLOCK" "_3D_ES_90_links")
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
"_3D_ES_90_links" 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(vla-Delete temp-obj)
|
||
(setq ks-ein-pos nil ks-aus-pos nil)
|
||
(foreach item ks-data
|
||
(if (= (car item) "KS_EIN") (setq ks-ein-pos (cadr item)))
|
||
(if (= (car item) "KS_AUS") (setq ks-aus-pos (cadr item)))
|
||
)
|
||
(if (and ks-ein-pos ks-aus-pos)
|
||
(progn
|
||
(setq ein-dx (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
|
||
(setq ein-dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
|
||
(setq ein-dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
|
||
(princ (strcat "\n EIN_Element: dx=" (rtos ein-dx 2 0) ", dz=" (rtos ein-dz 2 0)))
|
||
)
|
||
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im EIN_Element!")
|
||
)
|
||
)
|
||
(princ "\n FEHLER: Block _3D_ES_90_links nicht gefunden!")
|
||
)
|
||
|
||
;; === Bogen-Maße extrahieren - ALLE Winkel ===
|
||
(princ "\n Extrahiere Bogen-Maße...")
|
||
(setq bogen-auf '())
|
||
(setq bogen-ab '())
|
||
|
||
;; ALLE verfügbaren Winkel
|
||
(setq bogen-winkel '(3 6 9 12 15 18 21 27 33 39 45 51))
|
||
|
||
(foreach w bogen-winkel
|
||
;; Aufwärtsbogen
|
||
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) grad-zeichen))
|
||
(if (tblsearch "BLOCK" bogen-name)
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
bogen-name 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(vla-Delete temp-obj)
|
||
|
||
(foreach item ks-data
|
||
(if (= (car item) "KS_EIN")
|
||
(setq ks-ein-pos (cadr item)))
|
||
(if (= (car item) "KS_AUS")
|
||
(setq ks-aus-pos (cadr item)))
|
||
)
|
||
|
||
(if (and ks-ein-pos ks-aus-pos)
|
||
(progn
|
||
(setq dx (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
|
||
(setq dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
|
||
(setq dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
|
||
(setq bogen-auf (cons (list w dx dy dz) bogen-auf))
|
||
(princ (strcat "\n ✓ Bogen_auf_" (itoa w) ": dx=" (rtos dx 2 0) " mm, dz=" (rtos dz 2 0) " mm"))
|
||
)
|
||
(princ (strcat "\n ✗ Bogen_auf_" (itoa w) ": KS_EIN/KS_AUS fehlt!"))
|
||
)
|
||
)
|
||
(princ (strcat "\n ✗ Bogen_auf_" (itoa w) ": Block nicht gefunden!"))
|
||
)
|
||
|
||
;; Abwärtsbogen
|
||
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) grad-zeichen))
|
||
(if (tblsearch "BLOCK" bogen-name)
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
bogen-name 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(vla-Delete temp-obj)
|
||
|
||
(foreach item ks-data
|
||
(if (= (car item) "KS_EIN")
|
||
(setq ks-ein-pos (cadr item)))
|
||
(if (= (car item) "KS_AUS")
|
||
(setq ks-aus-pos (cadr item)))
|
||
)
|
||
|
||
(if (and ks-ein-pos ks-aus-pos)
|
||
(progn
|
||
(setq dx (- (caaddr ks-aus-pos) (caadr ks-ein-pos)))
|
||
(setq dy (- (cadr (caddr ks-aus-pos)) (cadr (cadr ks-ein-pos))))
|
||
(setq dz (- (caddr (caddr ks-aus-pos)) (caddr (cadr ks-ein-pos))))
|
||
(setq bogen-ab (cons (list w dx dy dz) bogen-ab))
|
||
(princ (strcat "\n ✓ Bogen_ab_" (itoa w) ": dx=" (rtos dx 2 0) " mm, dz=" (rtos dz 2 0) " mm"))
|
||
)
|
||
(princ (strcat "\n ✗ Bogen_ab_" (itoa w) ": KS_EIN/KS_AUS fehlt!"))
|
||
)
|
||
)
|
||
(princ (strcat "\n ✗ Bogen_ab_" (itoa w) ": Block nicht gefunden!"))
|
||
)
|
||
)
|
||
|
||
(setq bogen-auf (reverse bogen-auf))
|
||
(setq bogen-ab (reverse bogen-ab))
|
||
|
||
(setq *lib-initialized* t)
|
||
(princ "\n Bibliothek erfolgreich initialisiert.")
|
||
(dbgreturn t)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Bogen-Maß aus Tabelle holen
|
||
(defun get-bogen-mass (tabelle winkel)
|
||
(dbgf "get-bogen-mass")
|
||
(setq result nil)
|
||
(foreach item tabelle
|
||
(if (= (car item) winkel)
|
||
(setq result (cdr item))
|
||
)
|
||
)
|
||
(if (null result)
|
||
(princ (strcat "\n FEHLER: Winkel " (itoa winkel) " nicht in Bogen-Tabelle!"))
|
||
)
|
||
(dbgreturn result)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 7: BLOCK EINFÜGEN MIT KS_EIN AUSRICHTUNG
|
||
;; ============================================================
|
||
(defun insert-block-by-ks (blockname einfuegepunkt / block-obj ks-data ks-ein ks-aus offset ausgang)
|
||
(dbgf "insert-block-by-ks")
|
||
|
||
(if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
|
||
(progn
|
||
(princ (strcat "\n FEHLER: Ungültiger Einfügepunkt für '" blockname "'"))
|
||
(exit)
|
||
)
|
||
)
|
||
|
||
;; Sicherstellen, dass Bibliothek initialisiert ist
|
||
(if (not *lib-initialized*)
|
||
(init-bibliothek)
|
||
)
|
||
|
||
(princ (strcat "\n Fuege Block '" blockname "' ein..."))
|
||
|
||
;; Block einfügen
|
||
(setq block-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point einfuegepunkt)
|
||
blockname 1.0 1.0 1.0 0))
|
||
|
||
;; KS-Daten extrahieren
|
||
(setq ks-data (extract-ks-from-block block-obj))
|
||
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
|
||
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
|
||
|
||
(if (and ks-ein ks-aus)
|
||
(progn
|
||
;; Verschieben, damit KS_EIN am Einfügepunkt liegt
|
||
(setq offset (list (- (car einfuegepunkt) (car (car ks-ein)))
|
||
(- (cadr einfuegepunkt) (cadr (car ks-ein)))
|
||
(- (caddr einfuegepunkt) (caddr (car ks-ein)))))
|
||
|
||
(vla-Move block-obj
|
||
(vlax-3D-point (car ks-ein))
|
||
(vlax-3D-point einfuegepunkt))
|
||
|
||
;; KS_AUS nach Verschiebung berechnen
|
||
(setq ausgang (list (+ (car (car ks-aus)) (car offset))
|
||
(+ (cadr (car ks-aus)) (cadr offset))
|
||
(+ (caddr (car ks-aus)) (caddr offset))))
|
||
|
||
(princ (strcat "\n KS_AUS: X=" (rtos (car ausgang) 2 2)
|
||
", Z=" (rtos (caddr ausgang) 2 2)))
|
||
|
||
(dbgreturn ausgang)
|
||
)
|
||
(progn
|
||
(princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!")
|
||
(dbgreturn einfuegepunkt)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 8: WINKELBERECHNUNG (NUR MIT BIBLIOTHEKSDATEN)
|
||
;; ============================================================
|
||
(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)
|
||
(dbgf "berechne-alle-winkel")
|
||
|
||
;; Bibliothek muss initialisiert sein
|
||
(if (not *lib-initialized*)
|
||
(progn
|
||
(alert "Bibliothek nicht initialisiert!\nBefehl abbrechen und neu starten.")
|
||
(exit)
|
||
)
|
||
)
|
||
|
||
(setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz))
|
||
|
||
;; ALLE in der Bibliothek verfügbaren Winkel
|
||
(setq winkel-list '(3 6 9 12 15 18 21 27 33 39 45 51))
|
||
|
||
(setq 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))
|
||
(princ "\n\n Winkel Bogen-Name (Auf) Bogen-Name (Ab)")
|
||
(princ "\n ---------------------------------------------------")
|
||
|
||
(foreach winkel winkel-list
|
||
;; Bogen-Maße aus Bibliothek holen (KEIN Fallback!)
|
||
(if (= richtung "Auf")
|
||
(setq mass1 (get-bogen-mass bogen-auf winkel))
|
||
(setq mass1 (get-bogen-mass bogen-ab winkel))
|
||
)
|
||
|
||
;; Debug-Ausgabe: Welcher Bogen wird verwendet?
|
||
(if (= richtung "Auf")
|
||
(princ (strcat "\n " (itoa winkel) "° Vario_Bogen_auf_" (itoa winkel) "°"))
|
||
(princ (strcat "\n " (itoa winkel) "° Vario_Bogen_ab_" (itoa winkel) "°"))
|
||
)
|
||
|
||
(if (null mass1)
|
||
(progn
|
||
(princ (strcat " → ⚠ NICHT VORHANDEN"))
|
||
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
|
||
)
|
||
(progn
|
||
(princ (strcat " → ✓ geladen (dx=" (rtos (car mass1) 2 0) ", dz=" (rtos (caddr mass1) 2 0) ")"))
|
||
(setq mass2 mass1) ;; Zweiter Bogen gleiche Maße
|
||
(setq bogen-x1 (car mass1) bogen-z1 (caddr mass1))
|
||
(setq bogen-x2 (car mass2) bogen-z2 (caddr 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
|
||
(setq B (+ deltaH abs-dz-AUS abs-dz-EIN (- bogen-z1) (- bogen-z2) (* FESTE_HORIZONTAL sin3)))
|
||
(setq nenner (+ (* cos3 sinα) (* sin3 cosα)))
|
||
)
|
||
(progn
|
||
(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))
|
||
|
||
;; Ausgabe der Ergebnisse
|
||
(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")
|
||
;; Wähle den kleinsten gültigen Winkel (wegen Herstellungskosten)
|
||
(if (or (null best-winkel) (< winkel best-winkel))
|
||
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
|
||
)
|
||
)
|
||
(princ "✗ UNGÜLTIG (negative Länge)")
|
||
)
|
||
)
|
||
(princ (strcat "\n " (itoa winkel) "° --- --- ✗ FEHLER"))
|
||
)
|
||
)
|
||
(princ "\n=================================================================================")
|
||
|
||
;; Ausgabe des empfohelnen Winkels
|
||
(if best-winkel
|
||
(princ (strcat "\n\n>>> Empfohlener Winkel: " (itoa best-winkel)
|
||
"° (kleinster verfuegbarer Winkel)"))
|
||
(princ "\n\n>>> KEIN passender Winkel gefunden!"))
|
||
|
||
(dbgreturn (list best-winkel best-L_GF best-L_VF ergebnis-liste))
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 9: MODULE EINFÜGEN (GESAMTE ANLAGE)
|
||
;; ============================================================
|
||
(defun foerderanlage-einfuegen (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt)
|
||
(dbgf "foerderanlage-einfuegen")
|
||
(setq aktueller-punkt startpunkt)
|
||
|
||
;; Bibliothek initialisieren
|
||
(if (not *lib-initialized*)
|
||
(init-bibliothek)
|
||
)
|
||
|
||
;; 1. AUS_Element
|
||
(princ "\n\n1/11: _3D_AS_90_links")
|
||
(setq aktueller-punkt (insert-block-by-ks "_3D_AS_90_links" aktueller-punkt))
|
||
|
||
;; 2. 1. Gefällestrecke (3°)
|
||
(if (> L_GF1 0.1)
|
||
(progn
|
||
(princ (strcat "\n\n2/11: Staustrecke (3 Grad, Laenge=" (rtos L_GF1 2 2) " mm)"))
|
||
(setq blockname "Staustrecke_SP_1000_mm")
|
||
(if (tblsearch "BLOCK" blockname)
|
||
(progn
|
||
(setq block (vla-InsertBlock modelspace
|
||
(vlax-3D-point aktueller-punkt)
|
||
blockname (/ L_GF1 1000.0) 1.0 1.0 0))
|
||
;; Rotation um Y-Achse
|
||
(setq rad (* 3 (/ pi 180.0)))
|
||
(setq matrix (list
|
||
(list (cos rad) 0 (sin rad) 0)
|
||
(list 0 1 0 0)
|
||
(list (- (sin rad)) 0 (cos rad) 0)
|
||
(list 0 0 0 1)
|
||
))
|
||
(vla-TransformBy block (vlax-tmatrix matrix))
|
||
(setq aktueller-punkt (list (+ (car aktueller-punkt) (* L_GF1 (cos rad)))
|
||
(cadr aktueller-punkt)
|
||
(+ (caddr aktueller-punkt) (* (- (sin rad)) L_GF1))))
|
||
)
|
||
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Zeichnung gefunden!"))
|
||
)
|
||
)
|
||
(princ "\n2/11: (uebersprungen)")
|
||
)
|
||
|
||
;; 3. Separator
|
||
(princ "\n\n3/11: Staustrecke_Separator_SP_300_mm")
|
||
(setq aktueller-punkt (insert-block-by-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt))
|
||
|
||
;; 4. Umlenkstation
|
||
(princ "\n\n4/11: Vario_Umlenkstation_500mm")
|
||
(setq aktueller-punkt (insert-block-by-ks "Vario_Umlenkstation_500mm" aktueller-punkt))
|
||
|
||
;; 5. Erster Vertikalbogen
|
||
(if (= richtung "Auf")
|
||
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
|
||
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
|
||
)
|
||
(princ (strcat "\n\n5/11: " bogen-name))
|
||
(setq aktueller-punkt (insert-block-by-ks bogen-name aktueller-punkt))
|
||
|
||
;; 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 "Staustrecke_SP_1000_mm")
|
||
(if (tblsearch "BLOCK" blockname)
|
||
(progn
|
||
(setq block (vla-InsertBlock modelspace
|
||
(vlax-3D-point aktueller-punkt)
|
||
blockname (/ L_VF 1000.0) 1.0 1.0 0))
|
||
(setq rad (* rot-winkel (/ pi 180.0)))
|
||
(setq matrix (list
|
||
(list (cos rad) 0 (sin rad) 0)
|
||
(list 0 1 0 0)
|
||
(list (- (sin rad)) 0 (cos rad) 0)
|
||
(list 0 0 0 1)
|
||
))
|
||
(vla-TransformBy block (vlax-tmatrix matrix))
|
||
(setq aktueller-punkt (list (+ (car aktueller-punkt) (* L_VF (cos rad)))
|
||
(cadr aktueller-punkt)
|
||
(+ (caddr aktueller-punkt) (* (- (sin rad)) L_VF))))
|
||
)
|
||
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Zeichnung gefunden!"))
|
||
)
|
||
)
|
||
(princ "\n6/11: (uebersprungen)")
|
||
)
|
||
|
||
;; 7. Zweiter Vertikalbogen (gegenläufig)
|
||
(if (= richtung "Auf")
|
||
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
|
||
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
|
||
)
|
||
(princ (strcat "\n\n7/11: " bogen-name))
|
||
(setq aktueller-punkt (insert-block-by-ks bogen-name aktueller-punkt))
|
||
|
||
;; 8. Motorstation
|
||
(princ "\n\n8/11: Vario_Motorstation_500mm")
|
||
(setq aktueller-punkt (insert-block-by-ks "Vario_Motorstation_500mm" aktueller-punkt))
|
||
|
||
;; 9. Zweite Gefällestrecke
|
||
(if (> L_GF2 0.1)
|
||
(progn
|
||
(princ (strcat "\n\n9/11: Staustrecke (3 Grad, Laenge=" (rtos L_GF2 2 2) " mm)"))
|
||
(setq blockname "Staustrecke_SP_1000_mm")
|
||
(if (tblsearch "BLOCK" blockname)
|
||
(progn
|
||
(setq block (vla-InsertBlock modelspace
|
||
(vlax-3D-point aktueller-punkt)
|
||
blockname (/ L_GF2 1000.0) 1.0 1.0 0))
|
||
(setq rad (* 3 (/ pi 180.0)))
|
||
(setq matrix (list
|
||
(list (cos rad) 0 (sin rad) 0)
|
||
(list 0 1 0 0)
|
||
(list (- (sin rad)) 0 (cos rad) 0)
|
||
(list 0 0 0 1)
|
||
))
|
||
(vla-TransformBy block (vlax-tmatrix matrix))
|
||
(setq aktueller-punkt (list (+ (car aktueller-punkt) (* L_GF2 (cos rad)))
|
||
(cadr aktueller-punkt)
|
||
(+ (caddr aktueller-punkt) (* (- (sin rad)) L_GF2))))
|
||
)
|
||
(princ (strcat "\n FEHLER: Block '" blockname "' nicht in Zeichnung gefunden!"))
|
||
)
|
||
)
|
||
(princ "\n9/11: (uebersprungen)")
|
||
)
|
||
|
||
;; 10. Separator 2
|
||
(princ "\n\n10/11: Staustrecke_Separator_SP_300_mm")
|
||
(setq aktueller-punkt (insert-block-by-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt))
|
||
|
||
;; 11. EIN_Element
|
||
(princ "\n\n11/11: _3D_ES_90_links")
|
||
(setq endpunkt (insert-block-by-ks "_3D_ES_90_links" aktueller-punkt))
|
||
|
||
(dbgreturn endpunkt)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 10: HAUPTFUNKTION
|
||
;; ============================================================
|
||
(defun c:FOERDERANLAGE ( / eingabe-modus startpunkt endpunkt differenz
|
||
deltaL deltaH deltaX deltaY richtung ergebnis
|
||
best-winkel L_GF L_GF1 L_GF2 L_VF ergebnis-liste
|
||
antwort verteilung-modus)
|
||
(dbgf "c:FOERDERANLAGE")
|
||
|
||
(princ "\n=========================================")
|
||
(princ "\n FÖRDERANLAGE GENERATOR v25.0")
|
||
(princ "\n (Komplett bibliotheksbasiert)")
|
||
(princ "\n=========================================")
|
||
|
||
;; Bibliothek initialisieren
|
||
(if (not (init-bibliothek))
|
||
(progn
|
||
(alert "Fehler beim Initialisieren der Bibliothek!\nBitte Pfade prüfen.")
|
||
(exit)
|
||
)
|
||
)
|
||
|
||
(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 <<<")
|
||
;; BKS auf WCS setzen für korrekte Z-Erfassung
|
||
(command "BKS" "W")
|
||
(princ "\n✓ BKS auf Weltkoordinaten gesetzt - Z-Höhe wird korrekt erfasst!")
|
||
|
||
;; ⬇️⬇️⬇️ IHRE ORIGINALE PUNKTE-AUSWAHL (VOLLSTÄNDIG ERHALTEN) ⬇️⬇️⬇️
|
||
(setq startpunkt
|
||
(get-3d-point-from-object
|
||
"\n1. START-PUNKT (Eingang des AUS_Elements): "))
|
||
(if (null startpunkt) (progn (alert "Kein Startpunkt!") (exit)))
|
||
|
||
;; DEBUG: Prüfen ob Z erfasst wurde
|
||
(princ (strcat "\n → Erfasste Z-Höhe: " (rtos (caddr startpunkt) 2 2) " mm"))
|
||
|
||
(setq endpunkt
|
||
(get-3d-point-from-object
|
||
"\n2. END-PUNKT (Ausgang des EIN_Elements): "))
|
||
(if (null endpunkt) (progn (alert "Kein Endpunkt!") (exit)))
|
||
|
||
(princ (strcat "\n → Erfasste Z-Höhe Endpunkt: " (rtos (caddr endpunkt) 2 2) " mm"))
|
||
;; ⬆️⬆️⬆️ IHRE ORIGINALE PUNKTE-AUSWAHL (VOLLSTÄNDIG ERHALTEN) ⬆️⬆️⬆️
|
||
|
||
(setq differenz (punkt-differenz startpunkt endpunkt))
|
||
(setq deltaX (abs (car differenz)))
|
||
(setq deltaY (abs (cadr differenz)))
|
||
(setq deltaH (caddr differenz))
|
||
|
||
;; Verwende die größere horizontale Distanz als Förderlänge
|
||
(setq deltaL (max deltaX deltaY))
|
||
|
||
(princ (strcat "\n → Horizontale Distanzen: ΔX = " (rtos deltaX 2 2) " mm, ΔY = " (rtos deltaY 2 2) " mm"))
|
||
(princ (strcat "\n → Gewählte Förderlänge ΔL = " (rtos deltaL 2 2) " mm (die größere Distanz)"))
|
||
(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"))
|
||
|
||
;; Richtung der Förderanlage (X oder Y) - für spätere Rotation
|
||
(if (> deltaY deltaX)
|
||
(princ "\n → Förderanlage wird in Y-Richtung erstellt")
|
||
(princ "\n → Förderanlage wird in X-Richtung erstellt")
|
||
)
|
||
|
||
(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)))
|
||
)
|
||
)
|
||
|
||
;; Berechnung
|
||
(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 (strcat "Kein passender Winkel gefunden!\n\n"
|
||
"ΔL=" (rtos deltaL 2 0) " mm, ΔH=" (rtos deltaH 2 0) " mm, Richtung=" richtung
|
||
"\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 Gefällestrecken
|
||
(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) 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) 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.")
|
||
)
|
||
|
||
(dbgreturn nil)
|
||
)
|
||
;; ============================================================
|
||
;; START
|
||
;; ============================================================
|
||
(princ "\n=========================================")
|
||
(princ "\n>>> FOERDERANLAGE GENERATOR v25.0 geladen <<<")
|
||
(princ "\n>>> Befehle: FOERDERANLAGE <<<")
|
||
(princ "\n>>> 100% bibliotheksbasiert - KEINE Fallbacks <<<")
|
||
(princ "\n=========================================")
|
||
(princ) |