Die KS-EIN und KS-AUS für Ein- und Ausschleuselemente wurde in Library angepasst.

This commit is contained in:
2026-06-01 14:52:14 +02:00
parent e41d6456d4
commit b54f2e7b46
2 changed files with 216 additions and 139 deletions
+216 -139
View File
@@ -183,6 +183,67 @@
(dbgreturn pt)
)
;; ============================================================
;; TEIL 5: 3D-LINIE AUSWÄHLEN (für Start- und Endpunkt mit Höhe)
;; ============================================================
(defun get-line-start-end-points (msg / ent obj start-pt end-pt)
(princ msg)
(princ "\n >> 3D-Linie oder Polylinie wählen (mit Höhendifferenz): ")
(setq ent (entsel))
(if ent
(progn
(setq obj (vlax-ename->vla-object (car ent)))
(setq obj-name (vla-get-ObjectName obj))
(cond
;; Fall 1: Es ist eine einfache Linie (AcDbLine)
((= obj-name "AcDbLine")
(setq start-pt (vlax-safearray->list
(vlax-variant-value (vla-get-StartPoint obj))))
(setq end-pt (vlax-safearray->list
(vlax-variant-value (vla-get-EndPoint obj))))
(princ (strcat "\n ✓ 3D-Linie erkannt:"
"\n Start: X=" (rtos (car start-pt) 2 2)
", Y=" (rtos (cadr start-pt) 2 2)
", Z=" (rtos (caddr start-pt) 2 2)
"\n Ende: X=" (rtos (car end-pt) 2 2)
", Y=" (rtos (cadr end-pt) 2 2)
", Z=" (rtos (caddr end-pt) 2 2)))
)
;; Fall 2: Es ist eine Polylinie (AcDbPolyline) - kann 3D-Punkte haben
((= obj-name "AcDbPolyline")
(setq start-pt (vlax-curve-getStartPoint obj))
(setq end-pt (vlax-curve-getEndPoint obj))
(princ (strcat "\n ✓ 3D-Polylinie erkannt:"
"\n Start: X=" (rtos (car start-pt) 2 2)
", Y=" (rtos (cadr start-pt) 2 2)
", Z=" (rtos (caddr start-pt) 2 2)
"\n Ende: X=" (rtos (car end-pt) 2 2)
", Y=" (rtos (cadr end-pt) 2 2)
", Z=" (rtos (caddr end-pt) 2 2)))
)
;; Fall 3: Anderer Objekttyp
(t
(princ "\n ✗ FEHLER: Keine Linie oder Polylinie ausgewählt!")
(setq start-pt nil)
(setq end-pt nil)
)
)
)
(progn
(princ "\n Kein Objekt gewählt.")
(setq start-pt nil)
(setq end-pt nil)
)
)
(if (and start-pt end-pt)
(list start-pt end-pt)
nil
)
)
;; ============================================================
;; TEIL 6: BIBLIOTHEK LADEN & MAßE EXTRAHIEREN
;; ============================================================
@@ -364,9 +425,9 @@
;; ============================================================
;; 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")
;; Block einfügen OHNE Rotation/Skalierung (für AUS/EIN Elemente)
(defun insert-block-by-ks (blockname einfuegepunkt / block-obj ks-data ks-ein ks-aus offset ausgang)
(if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
(progn
(princ (strcat "\n FEHLER: Ungültiger Einfügepunkt für '" blockname "'"))
@@ -374,26 +435,20 @@
)
)
;; Sicherstellen, dass Bibliothek initialisiert ist
(if (not *lib-initialized*)
(init-bibliothek)
)
(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)))))
@@ -402,23 +457,107 @@
(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)
ausgang
)
(progn
(princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!")
(dbgreturn einfuegepunkt)
einfuegepunkt
)
)
)
;; Skalierte und geneigte Staustrecke einfügen (vereinfacht, ohne KS-Extraktion)
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel /
rad matrix block-obj endpunkt scale)
(if (<= laenge 0.1)
(progn
(princ (strcat "\n Laenge=" (rtos laenge 2 2) " mm -> uebersprungen"))
startpunkt
)
(progn
(princ (strcat "\n Fuege '" blockname "' ein (Laenge=" (rtos laenge 2 2) " mm, Winkel=" (itoa winkel) "°)"))
(setq scale (/ laenge 1000.0))
(setq rad (* winkel (/ pi 180.0)))
;; Block direkt am Startpunkt einfügen (nicht erst bei 0,0,0)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point startpunkt)
blockname scale 1.0 1.0 0))
;; Rotation um Y-Achse
(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-obj (vlax-tmatrix matrix))
;; Endpunkt berechnen (für die Verkettung)
(setq endpunkt (list (+ (car startpunkt) (* laenge (cos rad)))
(cadr startpunkt)
(+ (caddr startpunkt) (* (- (sin rad)) laenge))))
(princ (strcat "\n Endpunkt: Z=" (rtos (caddr endpunkt) 2 2)))
endpunkt
)
)
)
;; Fixen Block mit Rotation einfügen (vereinfacht, ohne KS-Extraktion)
(defun insert-rotated-block-with-ks (blockname startpunkt winkel /
rad matrix block-obj endpunkt block-laenge)
(if (or (null startpunkt) (not (listp startpunkt)))
(progn
(princ (strcat "\n FEHLER: Ungültiger Einfügepunkt für '" blockname "'"))
startpunkt
)
(progn
(princ (strcat "\n Fuege Block '" blockname "' ein (Rotation " (itoa winkel) "°)"))
(setq rad (* winkel (/ pi 180.0)))
;; Block direkt am Startpunkt einfügen
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point startpunkt)
blockname 1.0 1.0 1.0 0))
;; Rotation um Y-Achse
(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-obj (vlax-tmatrix matrix))
;; Blocklänge für Endpunkt-Berechnung (geschätzt)
(setq block-laenge 300)
(cond
((vl-string-search "Umlenk" blockname) (setq block-laenge 500))
((vl-string-search "Motor" blockname) (setq block-laenge 500))
((vl-string-search "Bogen" blockname) (setq block-laenge 800))
(t (setq block-laenge 300))
)
(setq endpunkt (list (+ (car startpunkt) (* block-laenge (cos rad)))
(cadr startpunkt)
(+ (caddr startpunkt) (* (- (sin rad)) block-laenge))))
(princ (strcat "\n Endpunkt: Z=" (rtos (caddr endpunkt) 2 2)))
endpunkt
)
)
)
;; ============================================================
;; TEIL 8: WINKELBERECHNUNG (NUR MIT BIBLIOTHEKSDATEN)
;; ============================================================
@@ -550,155 +689,95 @@
;; 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)
)
(if (not *lib-initialized*) (init-bibliothek))
;; 1. AUS_Element
(princ "\n\n1/11: _3D_AS_90_links")
(princ "\n\n1/11: _3D_AS_90_links (0°)")
(setq aktueller-punkt (insert-block-by-ks "_3D_AS_90_links" aktueller-punkt))
;; 2. 1. Gefällestrecke (3°)
;; 2. 1. Gefällestrecke
(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 (strcat "\n\n2/11: Gefaellestrecke (3°, Laenge=" (rtos L_GF1 2 2) " mm)"))
(setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3))
)
(princ "\n2/11: (uebersprungen)")
(princ "\n\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))
(princ "\n\n3/11: Separator (300mm, 3° geneigt)")
(setq aktueller-punkt (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt 3))
;; 4. Umlenkstation
(princ "\n\n4/11: Vario_Umlenkstation_500mm")
(setq aktueller-punkt (insert-block-by-ks "Vario_Umlenkstation_500mm" aktueller-punkt))
;; 5. Erster Vertikalbogen
(princ "\n\n4/11: Umlenkstation (500mm, 3° geneigt)")
(setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3))
;; 5. 1. Vertikalbogen
(if (= richtung "Auf")
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
)
(princ (strcat "\n\n5/11: " bogen-name))
(setq aktueller-punkt (insert-block-by-ks bogen-name aktueller-punkt))
(princ (strcat "\n\n5/11: " bogen-name " (3° geneigt)"))
(setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt 3))
;; 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))
(princ (strcat "\n\n6/11: Steigungsstrecke (" (itoa best-winkel) "°, Laenge=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_VF (- 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)
(princ (strcat "\n\n6/11: Gefaellestrecke (" (itoa best-winkel) "°, Laenge=" (rtos L_VF 2 2) " mm)"))
(setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_VF 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)")
(princ "\n\n6/11: (uebersprungen)")
)
;; 7. Zweiter Vertikalbogen (gegenläufig)
;; 7. 2. Vertikalbogen
(if (= richtung "Auf")
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
)
(princ (strcat "\n\n7/11: " bogen-name))
(setq aktueller-punkt (insert-block-by-ks bogen-name aktueller-punkt))
(princ (strcat "\n\n7/11: " bogen-name " (3° geneigt)"))
(setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt (- best-winkel)))
;; 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
(princ "\n\n8/11: Motorstation (500mm, 3° geneigt)")
(setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 3))
;; 9. 2. 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 (strcat "\n\n9/11: Gefaellestrecke (3°, Laenge=" (rtos L_GF2 2 2) " mm)"))
(setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF2 3))
)
(princ "\n9/11: (uebersprungen)")
(princ "\n\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))
(princ "\n\n10/11: Separator (300mm, 3° geneigt)")
(setq aktueller-punkt (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt 3))
;; 11. EIN_Element
(princ "\n\n11/11: _3D_ES_90_links")
(princ "\n\n11/11: _3D_ES_90_links (0°)")
(setq endpunkt (insert-block-by-ks "_3D_ES_90_links" aktueller-punkt))
(dbgreturn endpunkt)
(princ "\n\n=========================================")
(princ "\n>>> Förderanlage erfolgreich eingefügt! <<<")
(princ "\n=========================================")
endpunkt
)
;; ============================================================
;; TEIL 10: HAUPTFUNKTION
;; ============================================================
(defun c:FOERDERANLAGE ( / eingabe-modus startpunkt endpunkt differenz
(defun c:FOERDERANLAGE ( / eingabe-modus line-points startpunkt endpunkt differenz
deltaL deltaH deltaX deltaY richtung ergebnis
best-winkel L_GF L_GF1 L_GF2 L_VF ergebnis-liste
antwort verteilung-modus)
@@ -718,39 +797,37 @@
)
(princ "\n\nEingabemodus wählen:")
(princ "\n 1 - Punkte auswählen (in der Zeichnung)")
(princ "\n 1 - 3D-Linie auswählen (Start- und Endpunkt mit Höhe)")
(princ "\n 2 - Werte manuell eingeben")
(setq antwort (getstring "\nIhre Wahl (1/2): "))
(cond
((= antwort "1") (setq eingabe-modus "Punkt"))
((= antwort "1") (setq eingabe-modus "Linie"))
((= antwort "2") (setq eingabe-modus "Wert"))
(t (setq eingabe-modus "Punkt") (princ "\nUngültige Eingabe, Modus 'Punkte auswählen'"))
(t (setq eingabe-modus "Linie") (princ "\nUngültige Eingabe, Modus '3D-Linie auswählen'"))
)
(if (= eingabe-modus "Punkt")
(if (= eingabe-modus "Linie")
(progn
(princ "\n\n>>> MODUS: Punkte auswählen <<<")
(princ "\n\n>>> MODUS: 3D-Linie 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)))
(setq line-points
(get-line-start-end-points
"\nBitte 3D-Linie (oder Polylinie) für die Förderstrecke auswählen:"))
;; DEBUG: Prüfen ob Z erfasst wurde
(princ (strcat "\n → Erfasste Z-Höhe: " (rtos (caddr startpunkt) 2 2) " mm"))
(if (null line-points)
(progn (alert "Keine gültige Linie ausgewählt!") (exit))
)
(setq endpunkt
(get-3d-point-from-object
"\n2. END-PUNKT (Ausgang des EIN_Elements): "))
(if (null endpunkt) (progn (alert "Kein Endpunkt!") (exit)))
(setq startpunkt (car line-points))
(setq endpunkt (cadr line-points))
(princ (strcat "\n → Erfasste Z-Höhe Endpunkt: " (rtos (caddr endpunkt) 2 2) " mm"))
;; ⬆️⬆️⬆️ IHRE ORIGINALE PUNKTE-AUSWAHL (VOLLSTÄNDIG ERHALTEN) ⬆️⬆️⬆️
(princ (strcat "\n → Start-Z-Höhe: " (rtos (caddr startpunkt) 2 2) " mm"))
(princ (strcat "\n → End-Z-Höhe: " (rtos (caddr endpunkt) 2 2) " mm"))
(setq differenz (punkt-differenz startpunkt endpunkt))
(setq deltaX (abs (car differenz)))
@@ -763,7 +840,7 @@
(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"))
(princ (strcat "\nGemessene Werte (aus 3D-Linie):\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)
Binary file not shown.