Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

die Fehler in VarioFoerderer.lsp korrigiert. alle in ILS-LSP verwendete Block Dateien in data/ils/ konsolidiert.

Browse Source
This commit is contained in:
Yuelin Wang
2026-06-02 10:00:36 +02:00
parent acf9f666cc
commit c014ef2f12
96 changed files with 166139 additions and 226 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/VarioFoerderer.lsp
+284 -222
View File
@@ -17,9 +17,9 @@
)
)
;; Pfad zur Koordinaten-Bibliothek
;; Pfad zum Verzeichnis mit den Einzelblock-DXF-Dateien
(if (getenv "DXFM_DATA")
(setq koordinaten-lib (strcat (getenv "DXFM_DATA") "/block_libraries/ils_library.dwg"))
(setq block-pfad (strcat (getenv "DXFM_DATA") "/ils/"))
(progn
(alert "Umgebungsvariable DXFM_DATA nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.")
(exit)
@@ -101,17 +101,36 @@
;; TEIL 4: KS_EIN/KS_AUS EXTRAKTION (KERN-FUNKTION)
;; ============================================================
;; Grad-Zeichen für Blocknamen
;; Grad-Zeichen fuer Blocknamen
(setq grad-zeichen (chr 176))
;; Laedt einen Block aus seiner Einzeldatei, falls noch nicht in der Zeichnung definiert.
;; Blockdatei: block-pfad/<blockname>.dxf
(defun ensure-block-loaded (blockname / block-datei temp-obj)
(if (not (tblsearch "BLOCK" blockname))
(progn
(setq block-datei (strcat block-pfad blockname ".dxf"))
(if (findfile block-datei)
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
block-datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj)
)
(princ (strcat "\n FEHLER: Blockdatei nicht gefunden: " block-datei))
)
)
)
)
;; Extrahiert KS_EIN und KS_AUS aus einem Block (intern, ohne Cache)
;; 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-raw (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-raw")
(dbg block-obj)
;; (dbgf "extract-ks-from-block-raw")
;; (dbg block-obj)
(setq ks-results '())
;; Block explodieren
@@ -167,7 +186,7 @@
(if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj))
)
(dbgreturn ks-results)
ks-results
)
;; Gecachte Version: prueft *ks-cache* anhand Blockname
@@ -175,18 +194,18 @@
;; zum Einfuegepunkt im Cache gespeichert. Weitere Aufrufe
;; desselben Blocktyps liefern die Daten ohne Explode.
(defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel)
(dbgf "extract-ks-from-block")
;; (dbgf "extract-ks-from-block")
(setq blockname (vla-get-Name block-obj))
(setq insert-pt (vlax-safearray->list
(vlax-variant-value (vla-get-InsertionPoint block-obj))))
(setq cached (assoc blockname *ks-cache*))
(if cached
(progn
(dbg (strcat " KS-Cache HIT: " blockname))
(dbgreturn (ks-absolutize (cdr cached) insert-pt))
;; (dbg (strcat " KS-Cache HIT: " blockname))
(ks-absolutize (cdr cached) insert-pt)
)
(progn
(dbg (strcat " KS-Cache MISS: " blockname))
;; (dbg (strcat " KS-Cache MISS: " blockname))
(setq result (extract-ks-from-block-raw block-obj))
(if result
(progn
@@ -194,7 +213,7 @@
(setq *ks-cache* (cons (cons blockname ks-rel) *ks-cache*))
)
)
(dbgreturn result)
result
)
)
)
@@ -203,7 +222,7 @@
;; 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")
;; (dbgf "get-3d-point-from-object")
(princ msg)
(princ "\n >> Objekt (Block) wählen: ")
(setq ent (entsel))
@@ -235,13 +254,13 @@
(setq pt nil)
)
)
(dbgreturn pt)
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)
(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt)
(princ msg)
(princ "\n >> 3D-Linie oder Polylinie wählen (mit Höhendifferenz): ")
(setq ent (entsel))
@@ -303,169 +322,151 @@
;; 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")
;; Laedt alle benoetigten Bloecke aus Einzeldateien und extrahiert KS-Masse.
(defun init-bibliothek ( / temp-obj bogen-winkel ks-data ks-ein-pos ks-aus-pos dx dy dz bogen-name)
;; (dbgf "init-bibliothek")
(if *lib-initialized*
(progn
(princ "\n Bibliothek bereits initialisiert.")
(dbgreturn t)
t
)
(progn
(setq *ks-cache* nil)
(princ "\n Lade Blockdefinitionen aus Bibliothek...")
(if (findfile koordinaten-lib)
(princ "\n Lade Blockdefinitionen aus Einzeldateien...")
(princ (strcat "\n Block-Pfad: " block-pfad))
;; === AUS_ELEMENT Masse extrahieren ===
(princ "\n Extrahiere AUS_Element Masse...")
(ensure-block-loaded "_3D_AS_90_links")
(if (tblsearch "BLOCK" "_3D_AS_90_links")
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
koordinaten-lib
1.0 1.0 1.0 0))
(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)
(princ " OK.")
;; === AUS_ELEMENT Maße extrahieren ===
(princ "\n Extrahiere AUS_Element Masse...")
(if (tblsearch "BLOCK" "_3D_AS_90_links")
(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 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!")
)
(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: Block _3D_AS_90_links nicht gefunden!")
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im AUS_Element!")
)
)
(princ "\n FEHLER: Block _3D_AS_90_links nicht geladen!")
)
;; === EIN_ELEMENT Maße extrahieren ===
(princ "\n Extrahiere EIN_Element Masse...")
(if (tblsearch "BLOCK" "_3D_ES_90_links")
;; === EIN_ELEMENT Masse extrahieren ===
(princ "\n Extrahiere EIN_Element Masse...")
(ensure-block-loaded "_3D_ES_90_links")
(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 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!")
)
(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: Block _3D_ES_90_links nicht gefunden!")
(princ "\n FEHLER: KS_EIN/KS_AUS fehlt im EIN_Element!")
)
;; === 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))
)
(princ "\n FEHLER: Block _3D_ES_90_links nicht geladen!")
)
(setq *lib-initialized* t)
(princ "\n Bibliothek erfolgreich initialisiert.")
(dbgreturn t)
;; === Bogen-Masse extrahieren - ALLE Winkel ===
(princ "\n Extrahiere Bogen-Masse...")
(setq bogen-auf '())
(setq bogen-ab '())
(setq bogen-winkel '(3 6 9 12 15 18 21 27 33 39 45 51))
(foreach w bogen-winkel
;; Aufwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) grad-zeichen))
(ensure-block-loaded bogen-name)
(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)
(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 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 OK Bogen_auf_" (itoa w) ": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
)
(princ (strcat "\n FEHLER Bogen_auf_" (itoa w) ": KS_EIN/KS_AUS fehlt!"))
)
)
(princ (strcat "\n FEHLER Bogen_auf_" (itoa w) ": Block nicht geladen!"))
)
;; Abwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) grad-zeichen))
(ensure-block-loaded bogen-name)
(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)
(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 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 OK Bogen_ab_" (itoa w) ": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0)))
)
(princ (strcat "\n FEHLER Bogen_ab_" (itoa w) ": KS_EIN/KS_AUS fehlt!"))
)
)
(princ (strcat "\n FEHLER Bogen_ab_" (itoa w) ": Block nicht geladen!"))
)
)
(setq bogen-auf (reverse bogen-auf))
(setq bogen-ab (reverse bogen-ab))
(setq *lib-initialized* t)
(princ "\n Bibliothek erfolgreich initialisiert.")
t
)
)
)
;; Bogen-Maß aus Tabelle holen
(defun get-bogen-mass (tabelle winkel)
(dbgf "get-bogen-mass")
;; (dbgf "get-bogen-mass")
(setq result nil)
(foreach item tabelle
(if (= (car item) winkel)
@@ -475,26 +476,27 @@
(if (null result)
(princ (strcat "\n FEHLER: Winkel " (itoa winkel) " nicht in Bogen-Tabelle!"))
)
(dbgreturn result)
result
)
;; ============================================================
;; TEIL 7: BLOCK EINFÜGEN MIT KS_EIN AUSRICHTUNG
;; ============================================================
;; Block einfügen OHNE Rotation/Skalierung (für AUS/EIN Elemente)
;; Block einfuegen OHNE Rotation/Skalierung (fuer 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 "'"))
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
(exit)
)
)
(if (not *lib-initialized*) (init-bibliothek))
(ensure-block-loaded blockname)
(princ (strcat "\n Fuege Block '" blockname "' ein..."))
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point einfuegepunkt)
blockname 1.0 1.0 1.0 0))
@@ -529,26 +531,27 @@
)
;; Skalierte und geneigte Staustrecke einfügen (vereinfacht, ohne KS-Extraktion)
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel /
(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
(ensure-block-loaded blockname)
(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)
;; Block am Ursprung einfuegen, damit TransformBy um (0,0,0) rotiert (= Block-Einfuegepunkt)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point startpunkt)
(vlax-3D-point '(0 0 0))
blockname scale 1.0 1.0 0))
;; Rotation um Y-Achse
;; Rotation um Y-Achse (rotiert jetzt korrekt um den Ursprung = Block-Einfuegepunkt)
(setq matrix (list
(list (cos rad) 0 (sin rad) 0)
(list 0 1 0 0)
@@ -556,6 +559,11 @@
(list 0 0 0 1)
))
(vla-TransformBy block-obj (vlax-tmatrix matrix))
;; Danach erst an den Startpunkt verschieben
(vla-Move block-obj
(vlax-3D-point '(0 0 0))
(vlax-3D-point startpunkt))
;; Endpunkt berechnen (für die Verkettung)
(setq endpunkt (list (+ (car startpunkt) (* laenge (cos rad)))
@@ -568,25 +576,26 @@
)
)
;; 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)
;; Fixen Block mit Rotation einfuegen (block-dx/block-dz = Ausdehnung in Block-X/Z)
(defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz /
rad matrix block-obj endpunkt)
(if (or (null startpunkt) (not (listp startpunkt)))
(progn
(princ (strcat "\n FEHLER: Ungültiger Einfügepunkt für '" blockname "'"))
(princ (strcat "\n FEHLER: Ungültiger Einfuegepunkt fuer '" blockname "'"))
startpunkt
)
(progn
(ensure-block-loaded blockname)
(princ (strcat "\n Fuege Block '" blockname "' ein (Rotation " (itoa winkel) "°)"))
(setq rad (* winkel (/ pi 180.0)))
;; Block direkt am Startpunkt einfügen
;; Block am Ursprung einfuegen, damit TransformBy korrekt um (0,0,0) rotiert
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point startpunkt)
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
;; Rotation um Y-Achse
(setq matrix (list
(list (cos rad) 0 (sin rad) 0)
@@ -595,21 +604,19 @@
(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)))
;; Danach erst an den Startpunkt verschieben
(vla-Move block-obj
(vlax-3D-point '(0 0 0))
(vlax-3D-point startpunkt))
;; Endpunkt: Rotation des (block-dx, 0, block-dz) Vektors um Y-Achse
(setq endpunkt (list
(+ (car startpunkt) (+ (* block-dx (cos rad)) (* block-dz (sin rad))))
(cadr startpunkt)
(+ (caddr startpunkt) (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz)))))
(princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2) " Z=" (rtos (caddr endpunkt) 2 2)))
endpunkt
)
)
@@ -621,8 +628,9 @@
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")
winkel mass1 mass2 gueltig
best-winkel best-L_GF best-L_VF)
;; (dbgf "berechne-alle-winkel")
;; Bibliothek muss initialisiert sein
(if (not *lib-initialized*)
@@ -738,13 +746,15 @@
"° (kleinster verfuegbarer Winkel)"))
(princ "\n\n>>> KEIN passender Winkel gefunden!"))
(dbgreturn (list best-winkel best-L_GF best-L_VF ergebnis-liste))
(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)
(defun foerderanlage-einfuegen (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt
/ aktueller-punkt bogen-name endpunkt bogen-mass bogen-dx bogen-dz
)
(setq aktueller-punkt startpunkt)
(if (not *lib-initialized*) (init-bibliothek))
@@ -764,19 +774,26 @@
;; 3. Separator
(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
(setq aktueller-punkt (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt 3 300 0))
;; 4. Umlenkstation – Block bereits 3° vorgeneigt, keine zusaetzliche Rotation
(princ "\n\n4/11: Umlenkstation (500mm, 3° geneigt)")
(setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3))
(setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 0 499 -26))
;; 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))
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (strcat "\n\n5/11: " bogen-name " (3° geneigt)"))
(setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt 3))
(setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz))
;; 6. Variable Strecke L_VF
(if (> L_VF 0.1)
@@ -797,16 +814,23 @@
;; 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))
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) grad-zeichen))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
)
(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
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (strcat "\n\n7/11: " bogen-name " (" (itoa (- best-winkel)) "° geneigt)"))
(setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt (- best-winkel) bogen-dx bogen-dz))
;; 8. Motorstation – gleiche Behandlung wie Umlenkstation
(princ "\n\n8/11: Motorstation (500mm, 3° geneigt)")
(setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 3))
(setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 0 499 -26))
;; 9. 2. Gefällestrecke
(if (> L_GF2 0.1)
(progn
@@ -818,7 +842,7 @@
;; 10. Separator 2
(princ "\n\n10/11: Separator (300mm, 3° geneigt)")
(setq aktueller-punkt (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt 3))
(setq aktueller-punkt (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt 3 300 0))
;; 11. EIN_Element
(princ "\n\n11/11: _3D_ES_90_links (0°)")
@@ -836,8 +860,9 @@
(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)
(dbgf "c:FOERDERANLAGE")
antwort verteilung-modus
gueltige-winkel idx eintrag wahl)
;; (dbgf "c:FOERDERANLAGE")
(princ "\n=========================================")
(princ "\n FÖRDERANLAGE GENERATOR v25.0")
@@ -927,19 +952,56 @@
;; 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
(setq ergebnis-liste (cadddr ergebnis))
;; Gueltige Winkel ermitteln
(setq gueltige-winkel
(mapcar 'car
(vl-remove-if-not
(function (lambda (e) (and (nth 3 e)
(numberp (nth 1 e)) (numberp (nth 2 e))
(>= (nth 1 e) 0) (>= (nth 2 e) 0))))
ergebnis-liste)))
(if (null gueltige-winkel)
(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."))
"DeltaL=" (rtos deltaL 2 0) " mm, DeltaH=" (rtos deltaH 2 0)
" mm, Richtung=" richtung "\nBitte andere Werte versuchen."))
(exit)
)
)
;; Winkelauswahl: bei einem Winkel automatisch, bei mehreren Dialog
(if (= (length gueltige-winkel) 1)
(progn
(setq best-winkel (car gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(princ (strcat "\n\n>>> Nur ein gueltiger Winkel: " (itoa best-winkel) grad-zeichen))
)
(progn
(princ "\n\nMehrere gueltige Winkel verfuegbar. Bitte waehlen:")
(setq idx 1)
(foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste))
(princ (strcat "\n " (itoa idx) " - " (itoa w) grad-zeichen
" (L_GF=" (rtos (nth 1 eintrag) 2 1)
" mm, L_VF=" (rtos (nth 2 eintrag) 2 1) " mm)"))
(setq idx (1+ idx))
)
(setq wahl (getint (strcat "Winkel waehlen (1-"
(itoa (length gueltige-winkel)) ") [1]: ")))
(if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
(setq wahl 1))
(setq best-winkel (nth (1- wahl) gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
)
)
(princ "\n\n=========================================")
(princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) "°"))
(princ (strcat "\n>>> Gewaehlter Winkel: " (itoa best-winkel) grad-zeichen))
(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=========================================")
@@ -985,7 +1047,7 @@
(princ "\nVorgang abgebrochen.")
)
(dbgreturn nil)
nil
)
;; ============================================================
;; START