diff --git a/Lisp/EtageVarioFoerderer.lsp b/Lisp/EtageVarioFoerderer.lsp index fc45b00..67f9a32 100644 --- a/Lisp/EtageVarioFoerderer.lsp +++ b/Lisp/EtageVarioFoerderer.lsp @@ -1,1113 +1,9 @@ ;; ============================================================ -;; ETAGE VARIO FOERDERER GENERATOR fuer BricsCAD Pro -;; Version: 1.0 -;; Befehl: ETAGEVARIOFOERDERER -;; Abhaengigkeit: VarioFoerderer.lsp muss zuerst geladen sein -;; (stellt bereit: ensure-block-loaded, insert-block-by-ks, -;; insert-inclined-scaled-block, insert-rotated-block-with-ks, -;; extract-ks-from-block, get-bogen-mass, bogen-auf, bogen-ab, -;; block-pfad, grad-zeichen, doc, modelspace, *ks-cache*) -;; -;; Block-Reihenfolge (15 Schritte): -;; 1. _3D_AS_30_rechts/links (Antriebsstation 30°) -;; 2. Staustrecke_SP_700_mm (700mm horizontal, skaliert aus 1000mm-Block) -;; 3. Separator_300 (Staustrecke_Separator_SP_300_mm, horizontal) -;; 4. Gefaellebogen_links_60°_R500 (fester Kurvenblock) -;; 5. L_GF1 (variable Gerade bei 3°) -;; 6. Vario_Umlenkstation_500mm (3° geneigt) -;; 7. 1. Vertikalbogen (3° rotiert) -;; 8. L_VF (variable Steigung/Gefaelle) -;; 9. 2. Vertikalbogen -;; 10. Vario_Motorstation_500mm (3° geneigt) -;; 11. L_GF2 (variable Gerade bei 3°) -;; 12. Gefaellebogen_links_60°_R500 (fester Kurvenblock) -;; 13. Separator_300 -;; 14. Staustrecke_SP_700_mm -;; 15. _3D_ES_30_rechts/links (Endstation 30°) +;; EtageVarioFoerderer.lsp — Kompatiblitaets-Wrapper +;; Laedt vf_core.lsp (Plugin-Dispatcher-Architektur) +;; c:ETAGEVARIOFOERDERER ist in vf_core.lsp als Alias definiert. ;; ============================================================ - -;; ============================================================ -;; TEIL 1: ABHAENGIGKEITS-PRUEFUNG -;; ============================================================ -;; VarioFoerderer.lsp sicherstellen (fuer direktes Laden ohne Menu-System). -;; Stellt bereit: ensure-block-loaded (laedt aus ils_library.dxf), -;; insert-block-by-ks, insert-inclined-scaled-block, -;; insert-rotated-block-with-ks, extract-ks-from-block, -;; get-bogen-mass, bogen-auf, bogen-ab, grad-zeichen, doc, modelspace -(if (not (car (atoms-family 1 '("ENSURE-BLOCK-LOADED")))) - (if (getenv "DXFM_LISP") - (load (strcat (getenv "DXFM_LISP") "/VarioFoerderer.lsp")) - (progn - (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.") - (exit) - ) - ) +(if (getenv "DXFM_LISP") + (load (strcat (getenv "DXFM_LISP") "/vf_core.lsp")) + (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.") ) - -;; ============================================================ -;; TEIL 2: ETAGE-SPEZIFISCHE GLOBALE VARIABLEN -;; ============================================================ -(setq etage-aus-dx nil etage-aus-dz nil) ;; AS_30 Masse (rechts als Referenz) -(setq etage-ein-dx nil etage-ein-dz nil) ;; ES_30 Masse (rechts als Referenz) -(setq etage-gef-dx nil etage-gef-dy nil etage-gef-dz nil) ;; Gefaellebogen aktive Seite -(setq etage-gef-dx-rechts nil etage-gef-dz-rechts nil) ;; Gefaellebogen rechts -(setq etage-gef-dx-links nil etage-gef-dz-links nil) ;; Gefaellebogen links -(setq *etage-lib-initialized* nil) - -;; Feste Laengen -(setq FESTE_ETAGE_MITTE 1000) ;; Umlenkstation(500) + Motorstation(500) bei 3° -(setq ETAGE_SCHRAEG_LAENGE 700) ;; Staustrecke_400 + Separator_300 = 700mm je Seite -(setq ETAGE_HZ_WINKEL 60) ;; Horizontalwinkel Schraegteile (Grad, um Z-Achse) - -;; Zeichen-Konstanten (falls VarioFoerderer.lsp noch nicht geladen) -(if (null grad-zeichen) (setq grad-zeichen (chr 176))) - -;; ============================================================ -;; TEIL 3: BIBLIOTHEK INITIALISIEREN (ETAGE-SPEZIFISCH) -;; ============================================================ -(defun init-bibliothek-etage ( / temp-obj ks-data ks-ein-pos ks-aus-pos - gefaelle-blockname) - ;; Sentinel: Flag zuruecksetzen wenn 3D-Bloecke in der Zeichnung fehlen - (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts"))) - (setq *etage-lib-initialized* nil)) - (if *etage-lib-initialized* - (progn (princ "\n Etage-Bibliothek bereits initialisiert.") t) - (progn - (princ "\n Initialisiere Etage-Bibliothek...") - - ;; VarioFoerderer-Bibliothek initialisieren (laedt Bogen-Daten bogen-auf/bogen-ab) - (if (not *lib-initialized*) - (init-bibliothek) - ) - - ;; === AS_30_rechts Masse extrahieren === - (princ "\n Extrahiere AS_30_rechts Masse...") - (ensure-block-loaded "_3D_AS_30_rechts") - (if (tblsearch "BLOCK" "_3D_AS_30_rechts") - (progn - (setq temp-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - "_3D_AS_30_rechts" 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 etage-aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq etage-aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) - (princ (strcat "\n AS_30_rechts: dx=" (rtos etage-aus-dx 2 1) - " mm, dz=" (rtos etage-aus-dz 2 1) " mm")) - ) - (progn - (princ "\n WARNUNG: KS_EIN/KS_AUS fehlt - verwende Standardwerte") - (setq etage-aus-dx 525.8 etage-aus-dz -72.9) - ) - ) - ) - (progn - (princ "\n WARNUNG: Block _3D_AS_30_rechts nicht in Bibliothek - verwende Standardwerte") - (setq etage-aus-dx 525.8 etage-aus-dz -72.9) - ) - ) - - ;; === ES_30_rechts Masse extrahieren === - (princ "\n Extrahiere ES_30_rechts Masse...") - (ensure-block-loaded "_3D_ES_30_rechts") - (if (tblsearch "BLOCK" "_3D_ES_30_rechts") - (progn - (setq temp-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - "_3D_ES_30_rechts" 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 etage-ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq etage-ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) - (princ (strcat "\n ES_30_rechts: dx=" (rtos etage-ein-dx 2 1) - " mm, dz=" (rtos etage-ein-dz 2 1) " mm")) - ) - (progn - (princ "\n WARNUNG: KS_EIN/KS_AUS fehlt - verwende Standardwerte") - (setq etage-ein-dx 576.2 etage-ein-dz -54.6) - ) - ) - ) - (progn - (princ "\n WARNUNG: Block _3D_ES_30_rechts nicht in Bibliothek - verwende Standardwerte") - (setq etage-ein-dx 576.2 etage-ein-dz -54.6) - ) - ) - - ;; === Gefaellebogen_links_60deg Masse extrahieren (dx, dz) === - (setq gefaelle-blockname - (strcat "Gefaellebogen_links_60" grad-zeichen "_R500")) - (princ (strcat "\n Extrahiere " gefaelle-blockname " Masse...")) - (ensure-block-loaded gefaelle-blockname) - (if (tblsearch "BLOCK" gefaelle-blockname) - (progn - (setq temp-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) gefaelle-blockname 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 etage-gef-dx-links (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq etage-gef-dz-links (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) - ) - (progn - (princ "\n WARNUNG: kein KS - Standardwerte (links)") - (setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0) - ) - ) - ) - (progn - (princ "\n WARNUNG: Block nicht gefunden - Standardwerte (links)") - (setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0) - ) - ) - (princ (strcat "\n Gefaellebogen links: dx=" (rtos etage-gef-dx-links 2 2) - " dz=" (rtos etage-gef-dz-links 2 2) " mm")) - - ;; === Gefaellebogen_rechts_60deg Masse extrahieren (dx, dz) === - (setq gefaelle-blockname - (strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500")) - (princ (strcat "\n Extrahiere " gefaelle-blockname " Masse...")) - (ensure-block-loaded gefaelle-blockname) - (if (tblsearch "BLOCK" gefaelle-blockname) - (progn - (setq temp-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) gefaelle-blockname 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 etage-gef-dx-rechts (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq etage-gef-dz-rechts (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) - ) - (progn - (princ "\n WARNUNG: kein KS - Standardwerte (rechts)") - (setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0) - ) - ) - ) - (progn - (princ "\n WARNUNG: Block nicht gefunden - Standardwerte (rechts)") - (setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0) - ) - ) - (princ (strcat "\n Gefaellebogen rechts: dx=" (rtos etage-gef-dx-rechts 2 2) - " dz=" (rtos etage-gef-dz-rechts 2 2) " mm")) - - ;; Etage-spezifische Bloecke vorladen - (ensure-block-loaded "_3D_AS_30_links") - (ensure-block-loaded "_3D_ES_30_links") - - (setq *etage-lib-initialized* t) - (princ "\n Etage-Bibliothek erfolgreich initialisiert.") - t - ) - ) -) - -;; ============================================================ -;; TEIL 3b: EINFUEGEFUNKTIONEN MIT KOMBINIERTER HZ+VERT ROTATION -;; ============================================================ -;; -;; Kombinierte Transformationsmatrix: Rz(hz) * Ry(vert) -;; [ cos(hz)*cos(vert) -sin(hz) cos(hz)*sin(vert) ] -;; [ sin(hz)*cos(vert) cos(hz) sin(hz)*sin(vert) ] -;; [ -sin(vert) 0 cos(vert) ] -;; -;; hz = Horizontalwinkel (Grad, Rotation um Z-Achse, Richtung in XY-Ebene) -;; vert = Vertikalwinkel (Grad, Rotation um Y-Achse, Neigung) - -;; Skalierter Block (z.B. Staustrecke_SP_1000_mm skaliert auf laenge mm) -(defun insert-hz-incl-scaled-block (blockname startpunkt laenge hz-winkel vert-winkel / - rad-hz rad-vert chz shz cv sv scale - matrix block-obj endpunkt) - (setq scale (/ (float laenge) 1000.0)) - (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) - (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) - (setq chz (cos rad-hz) shz (sin rad-hz)) - (setq cv (cos rad-vert) sv (sin rad-vert)) - - (ensure-block-loaded blockname) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - Einfuegen abgebrochen")) - (exit) - ) - ) - (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0)) - - (setq matrix (list - (list (* chz cv) (- shz) (* chz sv) 0) - (list (* shz cv) chz (* shz sv) 0) - (list (- sv) 0 cv 0) - (list 0 0 0 1) - )) - (vla-TransformBy block-obj (vlax-tmatrix matrix)) - (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt)) - - ;; Endpunkt: (laenge,0,0) transformiert -> (laenge*chz*cv, laenge*shz*cv, -laenge*sv) - (setq endpunkt (list - (+ (car startpunkt) (* laenge chz cv)) - (+ (cadr startpunkt) (* laenge shz cv)) - (+ (caddr startpunkt) (* (- sv) laenge)))) - - (princ (strcat "\n HzIncl " blockname " L=" (rtos laenge 2 0) - " hz=" (rtos hz-winkel 2 0) (chr 176) - " v=" (rtos vert-winkel 2 0) (chr 176) - " -> X=" (rtos (car endpunkt) 2 1) - " Y=" (rtos (cadr endpunkt) 2 1) - " Z=" (rtos (caddr endpunkt) 2 1))) - endpunkt -) - -;; Fester Block (z.B. Separator) mit bekanntem block-dx, block-dz -(defun insert-hz-rotated-block-with-ks (blockname startpunkt hz-winkel vert-winkel block-dx block-dz / - rad-hz rad-vert chz shz cv sv - matrix block-obj endpunkt) - (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) - (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) - (setq chz (cos rad-hz) shz (sin rad-hz)) - (setq cv (cos rad-vert) sv (sin rad-vert)) - - (ensure-block-loaded blockname) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - Einfuegen abgebrochen")) - (exit) - ) - ) - (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) - - (setq matrix (list - (list (* chz cv) (- shz) (* chz sv) 0) - (list (* shz cv) chz (* shz sv) 0) - (list (- sv) 0 cv 0) - (list 0 0 0 1) - )) - (vla-TransformBy block-obj (vlax-tmatrix matrix)) - (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt)) - - ;; Endpunkt: Richtungsvektor (block-dx, 0, block-dz) transformiert - (setq endpunkt (list - (+ (car startpunkt) (+ (* block-dx chz cv) (* block-dz chz sv))) - (+ (cadr startpunkt) (+ (* block-dx shz cv) (* block-dz shz sv))) - (+ (caddr startpunkt) (+ (* (- sv) block-dx) (* cv block-dz))))) - - (princ (strcat "\n HzRot " blockname - " hz=" (rtos hz-winkel 2 0) (chr 176) - " v=" (rtos vert-winkel 2 0) (chr 176) - " -> X=" (rtos (car endpunkt) 2 1) - " Y=" (rtos (cadr endpunkt) 2 1) - " Z=" (rtos (caddr endpunkt) 2 1))) - endpunkt -) - -;; Block mit kombinierter hz+vert Rotation einfuegen, ausgerichtet an KS_EIN -;; (statt am Block-Einfuegepunkt), damit der Block exakt an das Vorgaengerteil anschliesst. -;; -;; Algorithmus: -;; 1. Lokale KS-Positionen (unreotiert) aus Cache holen -;; 2. Block am Ursprung einfuegen, Rotationsmatrix anwenden -;; 3. Rotierte KS_EIN-Position berechnen (Matrixmultiplikation) -;; 4. Block verschieben: rotiertes KS_EIN -> startpunkt -;; 5. Rotiertes KS_AUS als naechsten aktueller-punkt zurueckgeben -(defun insert-hz-rotated-block-by-ks (blockname startpunkt hz-winkel vert-winkel / - rad-hz rad-vert chz shz cv sv - temp-obj block-obj ks-data ks-ein ks-aus - p-ein p-aus p-ein-rot p-aus-rot - offset ausgang) - (ensure-block-loaded blockname) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) - (exit) - ) - ) - - ;; Rotationsparameter - (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) - (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) - (setq chz (cos rad-hz) shz (sin rad-hz)) - (setq cv (cos rad-vert) sv (sin rad-vert)) - - ;; Schritt 1: KS-Positionen im lokalen Koordinatensystem holen (Block bei 0° am Ursprung) - ;; Nutzt den Cache aus init-bibliothek-etage -> kein Explode noetig - (setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) - (setq ks-data (extract-ks-from-block temp-obj)) - (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) - - (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) - (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) - - ;; Schritt 2: Eigentlichen Block einfuegen und rotieren (Rz(hz) * Ry(vert)) - (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) - (vla-TransformBy block-obj (vlax-tmatrix - (list (list (* chz cv) (- shz) (* chz sv) 0) - (list (* shz cv) chz (* shz sv) 0) - (list (- sv) 0 cv 0) - (list 0 0 0 1)))) - - (if (and ks-ein ks-aus) - (progn - ;; Lokale Ursprungspunkte der KS-Marker - (setq p-ein (car ks-ein)) - (setq p-aus (car ks-aus)) - - ;; Rotation anwenden: p' = Rz(hz)*Ry(vert) * p - ;; x' = chz*cv*x - shz*y + chz*sv*z - ;; y' = shz*cv*x + chz*y + shz*sv*z - ;; z' = -sv*x + cv*z - (setq p-ein-rot - (list (+ (* chz cv (car p-ein)) (- (* shz (cadr p-ein))) (* chz sv (caddr p-ein))) - (+ (* shz cv (car p-ein)) (* chz (cadr p-ein)) (* shz sv (caddr p-ein))) - (+ (* (- sv) (car p-ein)) (* cv (caddr p-ein))))) - (setq p-aus-rot - (list (+ (* chz cv (car p-aus)) (- (* shz (cadr p-aus))) (* chz sv (caddr p-aus))) - (+ (* shz cv (car p-aus)) (* chz (cadr p-aus)) (* shz sv (caddr p-aus))) - (+ (* (- sv) (car p-aus)) (* cv (caddr p-aus))))) - - ;; Schritt 3: Block verschieben -> rotiertes KS_EIN auf startpunkt - (vla-Move block-obj - (vlax-3D-point p-ein-rot) - (vlax-3D-point startpunkt)) - - ;; Schritt 4: Ausgang = rotiertes KS_AUS verschoben um denselben Offset - (setq offset (list (- (car startpunkt) (car p-ein-rot)) - (- (cadr startpunkt) (cadr p-ein-rot)) - (- (caddr startpunkt) (caddr p-ein-rot)))) - (setq ausgang (list (+ (car p-aus-rot) (car offset)) - (+ (cadr p-aus-rot) (cadr offset)) - (+ (caddr p-aus-rot) (caddr offset)))) - - (princ (strcat "\n HzRotKS " blockname - " hz=" (rtos hz-winkel 2 0) (chr 176) - " v=" (rtos vert-winkel 2 0) (chr 176) - " -> X=" (rtos (car ausgang) 2 1) - " Y=" (rtos (cadr ausgang) 2 1) - " Z=" (rtos (caddr ausgang) 2 1))) - ausgang - ) - (progn - (princ (strcat "\n WARNUNG: KS_EIN/KS_AUS fehlt in '" blockname "' - verwende Startpunkt")) - startpunkt - ) - ) -) - -;; Block mit kombinierter hz+vert Rotation UND X-Skalierung einfuegen, -;; ausgerichtet an KS_EIN (statt am Block-Einfuegepunkt). -;; laenge: Ziellaenge mm; Basisblock ist 1000mm lang (XScale = laenge/1000). -(defun insert-hz-scaled-block-by-ks (blockname startpunkt laenge hz-winkel vert-winkel / - rad-hz rad-vert chz shz cv sv scale - temp-obj block-obj ks-data ks-ein ks-aus - p-ein p-aus p-ein-s p-aus-s - p-ein-rot p-aus-rot offset ausgang) - (ensure-block-loaded blockname) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) - (exit) - ) - ) - - ;; XScale = laenge / Basislaenge (1000mm) - (setq scale (/ (float laenge) 1000.0)) - - (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) - (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) - (setq chz (cos rad-hz) shz (sin rad-hz)) - (setq cv (cos rad-vert) sv (sin rad-vert)) - - ;; Schritt 1: KS-Positionen bei Massstab 1 aus Cache - (setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) - (setq ks-data (extract-ks-from-block temp-obj)) - (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) - - (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) - (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) - - ;; Schritt 2: Block mit XScale einfuegen und rotieren (Rz(hz) * Ry(vert)) - (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0)) - (vla-TransformBy block-obj (vlax-tmatrix - (list (list (* chz cv) (- shz) (* chz sv) 0) - (list (* shz cv) chz (* shz sv) 0) - (list (- sv) 0 cv 0) - (list 0 0 0 1)))) - - (if (and ks-ein ks-aus) - (progn - ;; X-Skalierung auf lokale KS-Punkte anwenden (vla-InsertBlock skaliert nur X) - (setq p-ein (car ks-ein)) - (setq p-aus (car ks-aus)) - (setq p-ein-s (list (* scale (car p-ein)) (cadr p-ein) (caddr p-ein))) - (setq p-aus-s (list (* scale (car p-aus)) (cadr p-aus) (caddr p-aus))) - - ;; Rotation: p' = Rz(hz)*Ry(vert) * p - ;; x' = chz*cv*x - shz*y + chz*sv*z - ;; y' = shz*cv*x + chz*y + shz*sv*z - ;; z' = -sv*x + cv*z - (setq p-ein-rot - (list (+ (* chz cv (car p-ein-s)) (- (* shz (cadr p-ein-s))) (* chz sv (caddr p-ein-s))) - (+ (* shz cv (car p-ein-s)) (* chz (cadr p-ein-s)) (* shz sv (caddr p-ein-s))) - (+ (* (- sv) (car p-ein-s)) (* cv (caddr p-ein-s))))) - (setq p-aus-rot - (list (+ (* chz cv (car p-aus-s)) (- (* shz (cadr p-aus-s))) (* chz sv (caddr p-aus-s))) - (+ (* shz cv (car p-aus-s)) (* chz (cadr p-aus-s)) (* shz sv (caddr p-aus-s))) - (+ (* (- sv) (car p-aus-s)) (* cv (caddr p-aus-s))))) - - ;; Block verschieben: rotiertes+skaliertes KS_EIN -> startpunkt - (vla-Move block-obj - (vlax-3D-point p-ein-rot) - (vlax-3D-point startpunkt)) - - (setq offset (list (- (car startpunkt) (car p-ein-rot)) - (- (cadr startpunkt) (cadr p-ein-rot)) - (- (caddr startpunkt) (caddr p-ein-rot)))) - (setq ausgang (list (+ (car p-aus-rot) (car offset)) - (+ (cadr p-aus-rot) (cadr offset)) - (+ (caddr p-aus-rot) (caddr offset)))) - - (princ (strcat "\n HzScaleKS " blockname - " " (rtos laenge 2 0) "mm" - " hz=" (rtos hz-winkel 2 0) (chr 176) - " v=" (rtos vert-winkel 2 0) (chr 176) - " -> X=" (rtos (car ausgang) 2 1) - " Y=" (rtos (cadr ausgang) 2 1) - " Z=" (rtos (caddr ausgang) 2 1))) - ausgang - ) - (progn - (princ (strcat "\n WARNUNG: KS_EIN/KS_AUS fehlt in '" blockname "' - verwende Startpunkt")) - startpunkt - ) - ) -) - -;; ============================================================ -;; TEIL 4: WINKELBERECHNUNG -;; ============================================================ -;; -;; Geometrie (gleich wie VarioFoerderer, andere feste Teile): -;; -;; Schraegteile (Staustrecke_500 + Separator_300 = 800mm je Seite): -;; 60deg horizontal (XY-Ebene) + 3deg vertikal -;; X-Beitrag: 800 * cos(60deg) * cos(3deg) = 800 * schraeg-cos -;; Z-Beitrag: 800 * sin(3deg) = 800 * sin3 -;; -;; X-Bilanz: -;; aus_dx + 700*schraeg-cos + gef_dx + L_GF*cos3 + FESTE_MITTE*cos3 -;; + b1x + L_VF*cosEff + b2x -;; + FESTE_MITTE*cos3 + L_GF*cos3 + gef_dx + 700*schraeg-cos + ein_dx = deltaL -;; -;; Vereinfacht: -;; A = deltaL - aus_dx - ein_dx - 2*700*schraeg-cos - 2*gef_dx -;; - 2*FESTE_MITTE*cos3 - b1x - b2x -;; L_GF*cos3 + L_VF*cosEff = A -;; -;; Z-Bilanz ("Auf"): -;; B = deltaH + |aus_dz| + |ein_dz| + 2*700*sin3 + 2*|gef_dz| -;; + 2*FESTE_MITTE*sin3 - b1z - b2z -;; L_GF*sin3 + L_VF*sinEff = B -;; -;; HINWEIS: FESTE_ETAGE_MITTE (Umlenkstation + Motorstation = 1000mm) -;; erscheint auf BEIDEN Seiten der Bogen (vor L_GF1 und nach L_GF2). -;; In der Formel wird es daher mit Faktor 2 berechnet: -;; FESTE_ETAGE_MITTE_GESAMT = 2 * 1000 = 2000mm bei 3° -;; Aber L_GF liegt ZWISCHEN Bogen und FESTE_MITTE, deshalb: -;; -> Nur EIN FESTE_ETAGE_MITTE tritt in die Gleichung ein (analog VarioFoerderer). -;; -> Der zweite L_GF absorbiert die restliche Laenge. -;; -;; Vereinfachung: L_GF = L_GF1 + L_GF2 (Gesamt, wie in VarioFoerderer) -;; -(defun berechne-winkel-etage (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 abs-dz-GEF - L_GF L_VF cosα sinα - winkel-eff cosEff sinEff rad5 rad7 - winkel mass1 mass2 gueltig - best-winkel best-L_GF best-L_VF - feste-gesamt-cos feste-gesamt-sin - schraeg-hz-rad schraeg-cos schraeg-z) - - (if (not *etage-lib-initialized*) - (progn - (alert "Etage-Bibliothek nicht initialisiert!") - (exit) - ) - ) - - (setq abs-dz-AUS (abs etage-aus-dz) - abs-dz-EIN (abs etage-ein-dz) - abs-dz-GEF (abs etage-gef-dz)) - - ;; FESTE_ETAGE_MITTE erscheint auf beiden Seiten der Vertikalbogen - ;; (Umlenkstation vor 1. Bogen, Motorstation nach 2. Bogen) - (setq winkel-list '(3 6 9 12 15 18 21 27 33 39 45 51)) - (setq ergebnis-liste '()) - (setq cos3 (cos (* 3.0 (/ pi 180.0))) - sin3 (sin (* 3.0 (/ pi 180.0)))) - - ;; FESTE_ETAGE_MITTE erscheint auf beiden Seiten der Vertikalbogen - (setq feste-gesamt-cos (* FESTE_ETAGE_MITTE cos3)) - (setq feste-gesamt-sin (* FESTE_ETAGE_MITTE sin3)) - ;; Schraegteile: 60° horizontal (XY-Ebene) + 3° vertikal - ;; X-Beitrag je Seite: L * cos(60deg) * cos(3deg) - ;; Z-Beitrag je Seite: L * sin(3deg) (nur vertikale Neigung!) - (setq schraeg-hz-rad (* (float ETAGE_HZ_WINKEL) (/ pi 180.0))) - (setq schraeg-cos (* (cos schraeg-hz-rad) cos3)) - - (princ "\n\n=========================================") - (princ "\n ETAGE-BERECHNUNG FUER ALLE WINKEL") - (princ "\n=========================================") - (princ (strcat "\ndeltaL = " (rtos deltaL 2 2) " mm")) - (princ (strcat "\ndeltaH = " (rtos deltaH 2 2) " mm")) - (princ (strcat "\nRichtung: " richtung)) - (princ (strcat "\nFeste Teile: AS_dx=" (rtos etage-aus-dx 2 1) - " ES_dx=" (rtos etage-ein-dx 2 1) - " 2x(800*cos60*cos3)=" (rtos (* 2.0 ETAGE_SCHRAEG_LAENGE schraeg-cos) 2 1) - " 2xGef_dx=" (rtos (* 2.0 etage-gef-dx) 2 2) - " 2xFESTE_MITTE*cos3=" (rtos (* 2.0 feste-gesamt-cos) 2 1))) - - (foreach winkel winkel-list - (if (= richtung "Auf") - (progn - (setq mass1 (get-bogen-mass bogen-auf winkel)) - (setq mass2 (get-bogen-mass bogen-ab winkel)) - ) - (progn - (setq mass1 (get-bogen-mass bogen-ab winkel)) - (setq mass2 (get-bogen-mass bogen-auf winkel)) - ) - ) - - (if (or (null mass1) (null mass2)) - (progn - (princ (strcat "\n " (itoa winkel) "° -> Bogen nicht vorhanden")) - (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste)) - ) - (progn - ;; Rotierte Bogen-Vorschuebe (identisch zu VarioFoerderer) - (setq rad5 (* 3.0 (/ pi 180.0))) - (setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3))) - (/ pi 180.0))) - - (setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5)))) - (setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5)))) - (setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7)))) - (setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7)))) - - (setq cosα (cos (* winkel (/ pi 180.0))) - sinα (sin (* winkel (/ pi 180.0)))) - (setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3))) - (setq cosEff (cos (* winkel-eff (/ pi 180.0))) - sinEff (sin (* winkel-eff (/ pi 180.0)))) - - ;; A: horizontaler Rest nach Abzug aller fester Teile - ;; Feste X-Beitraege: - ;; - AS_30 Block (etage-aus-dx) - ;; - 2 x (Staustrecke_500 + Separator_300) * cos60° = 2 x 800 * cos60 - ;; - 2 x Gefaellebogen dx (etage-gef-dx) - ;; - 2 x FESTE_ETAGE_MITTE * cos3 (Umlenkstation + Motorstation bei 3°) - ;; - Bogen-Vorschuebe bogen-x1, bogen-x2 - ;; - ES_30 Block (etage-ein-dx) - (setq A (- deltaL - etage-aus-dx - etage-ein-dx - (* 2.0 ETAGE_SCHRAEG_LAENGE schraeg-cos) - (* 2.0 etage-gef-dx) - bogen-x1 - bogen-x2 - (* 2.0 feste-gesamt-cos))) - - ;; B: vertikaler Rest - ;; Vorzeichen-Logik analog VarioFoerderer - ;; Z-Beitrag der Schraegteile (800mm, 3deg vertikal): 800*sin3 Absenkung je Seite - (setq schraeg-z (* ETAGE_SCHRAEG_LAENGE sin3)) - (if (= richtung "Auf") - (setq B (+ deltaH - abs-dz-AUS - abs-dz-EIN - (* 2.0 schraeg-z) - (* 2.0 abs-dz-GEF) - (- bogen-z1) - (- bogen-z2) - (* 2.0 feste-gesamt-sin))) - (setq B (+ (- deltaH - abs-dz-AUS - abs-dz-EIN - (* 2.0 schraeg-z) - (* 2.0 abs-dz-GEF) - (* 2.0 feste-gesamt-sin)) - bogen-z1 - bogen-z2)) - ) - - ;; Gleichungssystem loesen - (if (> (abs sinα) 0.0001) - (progn - (setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα)) - (if (= richtung "Auf") - (setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα)) - (setq L_VF (/ (- (* B cos3) (* A sin3)) sinα)) - ) - (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)) - - ;; Ergebnistabelle ausgeben - (princ "\n\n=================================================================================") - (princ "\n ERGEBNISTABELLE (L_GF = gesamt beider GF-Strecken)") - (princ "\n=================================================================================") - (princ "\n Winkel L_GF (mm) L_VF (mm) Status") - (princ "\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) (chr 176) - " " (if (numberp L_GF) (rtos L_GF 2 1) "---") " mm" - " " (if (numberp L_VF) (rtos L_VF 2 1) "---") " mm ")) - (if gueltig - (progn - (princ "GUELTIG") - (if (or (null best-winkel) (< winkel best-winkel)) - (setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF) - ) - ) - (princ "UNGUELTIG (negative Laenge)") - ) - ) - (princ (strcat "\n " (itoa winkel) (chr 176) - " --- --- FEHLER")) - ) - ) - (princ "\n=================================================================================") - - (if best-winkel - (princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176))) - (princ "\n>>> KEIN passender Winkel gefunden!") - ) - - (list best-winkel best-L_GF best-L_VF ergebnis-liste) -) - -;; ============================================================ -;; TEIL 5: VarioFoerderer EINFUEGEN (15 SCHRITTE) -;; ============================================================ -(defun etage-foerderanlage-einfuegen (deltaL deltaH richtung - best-winkel L_GF1 L_GF2 L_VF - startpunkt seite - / aktueller-punkt bogen-name endpunkt - bogen-mass bogen-dx bogen-dz - as-block es-block gefaelle-blockname - hz-vorzeichen hz-anfang hz-ende) - - (setq aktueller-punkt startpunkt) - ;; Vorzeichen des Horizontalwinkels je nach Seite: - ;; rechts: Anfang +60deg (links), Ende -60deg (rechts) - ;; links: Anfang -60deg (rechts), Ende +60deg (links) - (setq hz-vorzeichen (if (= seite "rechts") 1 -1)) - (setq hz-anfang (* hz-vorzeichen ETAGE_HZ_WINKEL)) - (setq hz-ende (* (- hz-vorzeichen) ETAGE_HZ_WINKEL)) - (setq as-block (strcat "_3D_AS_30_" seite)) - (setq es-block (strcat "_3D_ES_30_" seite)) - (setq gefaelle-blockname - (if (= seite "rechts") - (strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500") - (strcat "Gefaellebogen_links_60" grad-zeichen "_R500") - )) - ;; Sentinel: *etage-lib-initialized* zuruecksetzen wenn 3D-Bloecke fehlen - ;; (Zeichnung gewechselt oder Bibliothek wurde nicht mit 3D-Bloecken geladen) - (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts"))) - (setq *etage-lib-initialized* nil)) - (if (not *etage-lib-initialized*) (init-bibliothek-etage)) - - ;; 1. Antriebsstation AS_30 - (princ (strcat "\n\n1/15: " as-block " (0°)")) - (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt)) - - ;; 2. Staustrecke_SP_400mm (hz-anfang horizontal, 3° vertikal, Ausrichtung per KS_EIN) - (princ (strcat "\n\n2/15: Staustrecke_SP_400_mm (" (itoa hz-anfang) "deg hz, 3deg vert, KS_EIN)")) - (setq aktueller-punkt - (insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt 400 hz-anfang 3)) - - ;; 3. Separator (hz-anfang horizontal, 3° vertikal) - (princ (strcat "\n\n3/15: Separator (300mm, " (itoa hz-anfang) "deg hz, 3deg vert)")) - (setq aktueller-punkt - (insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt hz-anfang 3 300 0)) - - ;; 4. Gefaellebogen (Anfang, hz-anfang horizontal, 0° vertikal, Ausrichtung per KS_EIN) - (princ (strcat "\n\n4/15: " gefaelle-blockname " (Anfang, " (itoa hz-anfang) "deg hz, 0deg vert, KS_EIN)")) - (setq aktueller-punkt - (insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt - hz-anfang 0)) - - ;; 5. L_GF1 (variable Gerade bei 3°) - (if (> L_GF1 0.1) - (progn - (princ (strcat "\n\n5/15: 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 "\n\n5/15: L_GF1 (uebersprungen, Laenge <= 0)") - ) - - ;; 6. Umlenkstation (3° geneigt) - (princ "\n\n6/15: Umlenkstation (500mm, 3° geneigt)") - (setq aktueller-punkt - (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3 500 0)) - - ;; 7. 1. Vertikalbogen (bei 3° rotiert) - (if (= richtung "Auf") - (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\n7/15: " bogen-name " (3° geneigt)")) - (setq aktueller-punkt - (insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz)) - - ;; 8. Variable Strecke L_VF - (if (> L_VF 0.1) - (progn - (if (= richtung "Auf") - (progn - (princ (strcat "\n\n8/15: Steigungsstrecke (" - (itoa (- (- best-winkel 3))) "°, Laenge=" (rtos L_VF 2 2) " mm)")) - (setq aktueller-punkt - (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt - L_VF (- (- best-winkel 3)))) - ) - (progn - (princ (strcat "\n\n8/15: Gefaellestrecke (" - (itoa (+ best-winkel 3)) "°, Laenge=" (rtos L_VF 2 2) " mm)")) - (setq aktueller-punkt - (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt - L_VF (+ best-winkel 3))) - ) - ) - ) - (princ "\n\n8/15: L_VF (uebersprungen, Laenge <= 0)") - ) - - ;; 9. 2. Vertikalbogen - (if (= richtung "Auf") - (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)) - ) - ) - (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass)) - (if (= richtung "Auf") - (progn - (princ (strcat "\n\n9/15: " bogen-name " (" (itoa (- 3 best-winkel)) "° geneigt)")) - (setq aktueller-punkt - (insert-rotated-block-with-ks bogen-name aktueller-punkt (- 3 best-winkel) bogen-dx bogen-dz)) - ) - (progn - (princ (strcat "\n\n9/15: " bogen-name " (" (itoa (+ best-winkel 3)) "° geneigt)")) - (setq aktueller-punkt - (insert-rotated-block-with-ks bogen-name aktueller-punkt (+ best-winkel 3) bogen-dx bogen-dz)) - ) - ) - - ;; 10. Motorstation (3° geneigt) - (princ "\n\n10/15: Motorstation (500mm, 3° geneigt)") - (setq aktueller-punkt - (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 3 500 0)) - - ;; 11. L_GF2 (variable Gerade bei 3°) - (if (> L_GF2 0.1) - (progn - (princ (strcat "\n\n11/15: 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 "\n\n11/15: L_GF2 (uebersprungen, Laenge <= 0)") - ) - - ;; 12. Gefaellebogen (Ende) - (princ (strcat "\n\n12/15: " gefaelle-blockname " (Ende)")) - (setq aktueller-punkt (insert-block-by-ks gefaelle-blockname aktueller-punkt)) - - ;; 13. Separator (Ende, hz-ende horizontal, 3° vertikal) - (princ (strcat "\n\n13/15: Separator (300mm, " (itoa hz-ende) "deg hz, 3deg vert)")) - (setq aktueller-punkt - (insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt hz-ende 3 300 0)) - - ;; 14. Staustrecke_SP_400mm (Ende, hz-ende horizontal, 3° vertikal, Ausrichtung per KS_EIN) - (princ (strcat "\n\n14/15: Staustrecke_SP_400_mm (" (itoa hz-ende) "deg hz, 3deg vert, KS_EIN)")) - (setq aktueller-punkt - (insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt 400 hz-ende 3)) - - ;; 15. Endstation ES_30 (Ende, hz-ende horizontal, 0° vertikal) - (princ (strcat "\n\n15/15: " es-block " (Ende, " (itoa hz-ende) "deg hz, 0deg vert)")) - (setq endpunkt - (insert-hz-rotated-block-with-ks es-block aktueller-punkt - hz-ende 0 - etage-ein-dx etage-ein-dz)) - - (princ "\n\n=========================================") - (princ "\n>>> Etage-VarioFoerderer erfolgreich eingefuegt! <<<") - (princ "\n=========================================") - - endpunkt -) - -;; ============================================================ -;; TEIL 6: HAUPTFUNKTION -;; ============================================================ -(defun c:ETAGEVARIOFOERDERER ( / eingabe-modus line-points startpunkt endpunkt - differenz deltaL deltaH deltaX deltaY - richtung ergebnis ergebnis-liste - best-winkel L_GF L_GF1 L_GF2 L_VF - gueltige-winkel idx eintrag wahl antwort - seite verteilung-modus - startpunkt-fuer-einfuegen) - - (princ "\n=========================================") - (princ "\n ETAGE VARIO FOERDERER GENERATOR v1.0") - (princ "\n=========================================") - - ;; Bibliothek initialisieren - (if (not (init-bibliothek-etage)) - (progn - (alert "Fehler beim Initialisieren der Etage-Bibliothek!") - (exit) - ) - ) - - ;; Eingabemodus - (princ "\n\nEingabemodus waehlen:") - (princ "\n 1 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)") - (princ "\n 2 - Werte manuell eingeben") - (setq antwort (getstring "\nIhre Wahl (1/2): ")) - - (cond - ((= antwort "1") (setq eingabe-modus "Linie")) - ((= antwort "2") (setq eingabe-modus "Wert")) - (t (setq eingabe-modus "Linie")) - ) - - (if (= eingabe-modus "Linie") - (progn - (princ "\n\n>>> MODUS: 3D-Linie auswaehlen <<<") - (command "BKS" "W") - (setq line-points - (get-line-start-end-points - "\nBitte 3D-Linie fuer die Etage-Foerderstrecke auswaehlen:")) - (if (null line-points) - (progn (alert "Keine gueltige Linie ausgewaehlt!") (exit)) - ) - (setq startpunkt (car line-points) - endpunkt (cadr line-points)) - (setq differenz (punkt-differenz startpunkt endpunkt)) - (setq deltaX (abs (car differenz)) - deltaY (abs (cadr differenz)) - deltaH (caddr differenz)) - (setq deltaL (max deltaX deltaY)) - (princ (strcat "\n deltaL = " (rtos deltaL 2 2) " mm (max aus deltaX=" (rtos deltaX 2 2) - ", deltaY=" (rtos deltaY 2 2) ")")) - (if (>= deltaH 0) - (progn (setq richtung "Auf") (princ "\n Foerderrichtung: AUF")) - (progn (setq richtung "Ab") (setq deltaH (abs deltaH)) (princ "\n Foerderrichtung: AB")) - ) - (setq startpunkt-fuer-einfuegen startpunkt) - ) - (progn - (princ "\n\n>>> MODUS: Manuelle Werteingabe <<<") - (setq deltaL (getreal "\nHorizontale Distanz deltaL (mm): ")) - (if (null deltaL) (setq deltaL 12000)) - (setq deltaH (getreal "\nHoehenunterschied |deltaH| (mm): ")) - (if (null deltaH) (setq deltaH 3000)) - (princ "\nFoerderrichtung:\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 waehlen: ")) - (if (null startpunkt-fuer-einfuegen) - (setq startpunkt-fuer-einfuegen '(0 0 0))) - ) - ) - - ;; Seite vorab waehlen (benoetigt fuer Gefaellebogen-dx in der Berechnung) - (princ "\n\nSeite waehlen:") - (princ "\n 1 - Rechts (_3D_AS_30_rechts / _3D_ES_30_rechts)") - (princ "\n 2 - Links (_3D_AS_30_links / _3D_ES_30_links)") - (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) - (if (= antwort "2") - (setq seite "links") - (setq seite "rechts") - ) - (princ (strcat "\n>>> Seite: " seite)) - ;; Gefaellebogen-Masse fuer die gewaehlte Seite aktivieren - (if (= seite "rechts") - (progn - (setq etage-gef-dx etage-gef-dx-rechts etage-gef-dz etage-gef-dz-rechts)) - (progn - (setq etage-gef-dx etage-gef-dx-links etage-gef-dz etage-gef-dz-links)) - ) - (princ (strcat "\n Gefaellebogen dx=" (rtos etage-gef-dx 2 2) " mm")) - - ;; Berechnung - (setq ergebnis (berechne-winkel-etage deltaL deltaH richtung)) - (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" - "deltaL=" (rtos deltaL 2 0) " mm, deltaH=" (rtos deltaH 2 0) - " mm, Richtung=" richtung - "\n\nHinweis: Etage-Foerderer benoetigt groessere horizontale" - " Distanz als Standard-Variofoerderer.\nBitte andere Werte versuchen.")) - (exit) - ) - ) - - ;; Winkelauswahl - (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)) - ) - (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) (chr 176) - " (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>>> Gewaehlter Winkel: " (itoa best-winkel) (chr 176))) - (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 L_GF1 / L_GF2 - (princ "\n\nVerteilung der Gefaellestrecken (L_GF1 vorne / L_GF2 hinten):") - (princ "\n 1 - Gleichmaessig (L_GF1 = L_GF2 = L_GF/2)") - (princ "\n 2 - Vorne Minimum (L_GF1=1000, L_GF2=Rest)") - (princ "\n 3 - Hinten Minimum (L_GF2=1000, L_GF1=Rest)") - (princ "\n 4 - Eigene Werte") - (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 1000.0) - (setq L_GF2 (max 0 (- L_GF 1000.0)))) - ((= verteilung-modus "3") - (setq L_GF2 1000.0) - (setq L_GF1 (max 0 (- L_GF 1000.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 (max 0 (- L_GF L_GF1))) - (princ (strcat "\n L_GF2 = " (rtos L_GF2 2 2) " mm"))) - (t - (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0))) - ) - - (princ (strcat "\n>>> L_GF1 (vorne): " (rtos L_GF1 2 2) " mm")) - (princ (strcat "\n>>> L_GF2 (hinten): " (rtos L_GF2 2 2) " mm")) - - ;; Einfuegen - (princ "\n\nMoechten Sie die Anlage einfuegen?") - (princ "\n 1 - Ja 2 - Nein") - (setq antwort (getstring "\nIhre Wahl (1/2): ")) - - (if (= antwort "1") - (etage-foerderanlage-einfuegen deltaL deltaH richtung best-winkel - L_GF1 L_GF2 L_VF - startpunkt-fuer-einfuegen seite) - (princ "\nVorgang abgebrochen.") - ) - - nil -) - -;; ============================================================ -;; START -;; ============================================================ -(princ "\n=========================================") -(princ "\n>>> ETAGE VARIO FOERDERER v1.0 geladen <<<") -(princ "\n>>> Befehl: ETAGEVARIOFOERDERER <<<") -(princ "\n=========================================") -(princ) diff --git a/Lisp/Gefaellestrecke.lsp b/Lisp/Gefaellestrecke.lsp index c19ceb3..137159d 100644 --- a/Lisp/Gefaellestrecke.lsp +++ b/Lisp/Gefaellestrecke.lsp @@ -1,190 +1,1252 @@ ;; ============================================================ ;; Gefaellestrecke.lsp - Gefaelle-Foerderanlage Generator +;; v2.0 - Standalone-Modul ;; -;; Erzeugt eine einfache Foerderanlage mit festem Gefaellewinkel: -;; AUS-Element → Staustrecke_SP_1000_mm (skaliert) → -;; Staustrecke_Separator_SP_300_mm → EIN-Element +;; Modus 1: Manuelle Werteingabe (einfache Gefaellestrecke) +;; Modus 2: 3D-Linie als Referenz +;; Modus 3: Linienzug aus LINE- und ARC-Objekten +;; ARC-Segmente werden durch Gefaellebogen-Bloecke ersetzt. +;; Vor jedem Bogen wird automatisch ein Separator eingefuegt. +;; Gefaellewinkel wird aus deltaH und Geometrie berechnet. ;; -;; Abhaengigkeiten (aus VarioFoerderer.lsp, muss vorher geladen sein): -;; block-pfad, aus-dx, ein-dx, *lib-initialized*, grad-zeichen -;; init-bibliothek, ensure-block-loaded -;; insert-block-by-ks, insert-inclined-scaled-block -;; insert-rotated-block-with-ks, get-line-start-end-points -;; punkt-differenz +;; Verfuegbare Gefaellebogen-Bloecke (aus ils_library.dxf): +;; Gefaellebogen_links_30(Grad)_R500 (30 Grad Linkskurve) +;; Gefaellebogen_links_60(Grad)_R500 (60 Grad Linkskurve) +;; Gefaellebogen_links_90(Grad)_R500 (90 Grad Linkskurve) +;; Gefaellebogen_rechts_30(Grad)_R500 (30 Grad Rechtskurve) +;; Gefaellebogen_rechts_60(Grad)_R500 (60 Grad Rechtskurve) +;; Gefaellebogen_rechts_90(Grad)_R500 (90 Grad Rechtskurve) ;; ;; Befehl: GEFAELLESTRECKE ;; ============================================================ +(vl-load-com) + ;; ============================================================ -;; TEIL 1: EINFUEGE-FUNKTION +;; TEIL 1: INITIALISIERUNG +;; ============================================================ + +(if (null grad-zeichen) (setq grad-zeichen (chr 176))) + +(if (null *gf-ks-cache*) (setq *gf-ks-cache* nil)) +(if (null *gf-lib-geladen*)(setq *gf-lib-geladen* nil)) + +;; COM-Objekte (Guard: nicht ueberschreiben wenn von vf_core gesetzt) +(if (null doc) + (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) +(if (null modelspace) + (setq modelspace (vla-get-ModelSpace doc))) + +;; Fallback-Werte fuer AS/ES-Blockabmessungen (Modus 1+2) +;; Werden von vf_standard.lsp ueberschrieben, falls geladen. +(if (null aus-dx) (setq aus-dx 526.0)) +(if (null ein-dx) (setq ein-dx 576.0)) +;; Lokale KS_EIN-Positionen (Blockursprung-relative Koordinaten, fuer Modus 3) +;; Werden in init-bibliothek gesetzt. +(if (null *aus-ks-ein-local*) (setq *aus-ks-ein-local* nil)) +(if (null *ein-ks-ein-local*) (setq *ein-ks-ein-local* nil)) +(if (null *lib-initialized*) (setq *lib-initialized* nil)) + +;; ============================================================ +;; TEIL 2: KERN-FUNKTIONEN (Guard: nicht doppelt definieren) +;; ============================================================ + +;; --- ssg-cfg-or Ersatz --- +(if (null (car (atoms-family 1 '("SSG-CFG-OR")))) + (defun ssg-cfg-or (kategorie schluessel standard) standard) +) + +;; --- Vektor-Laenge --- +(if (null (car (atoms-family 1 '("VEC-LENGTH")))) + (defun vec-length (v) + (sqrt (+ (* (car v) (car v)) + (* (cadr v) (cadr v)) + (* (caddr v) (caddr v))))) +) + +;; --- Achsenkennung aus Linienlaenge fuer KS-Extraktion --- +(if (null (car (atoms-family 1 '("KS-LINE-AXIS")))) + (defun ks-line-axis (len) + (cond + ((and (> len 0.5) (< len 1.5)) "X") + ((and (> len 99) (< len 101)) "X") + ((and (> len 1.5) (< len 2.5)) "Y") + ((and (> len 2.5) (< len 3.5)) "Z") + (t nil))) +) + +;; --- Punkt-Differenz --- +(if (null (car (atoms-family 1 '("PUNKT-DIFFERENZ")))) + (defun punkt-differenz (p1 p2) + (list (- (car p2) (car p1)) + (- (cadr p2) (cadr p1)) + (- (caddr p2) (caddr p1)))) +) + +;; --- Block aus ils_library.dxf laden --- +(if (null (car (atoms-family 1 '("ENSURE-BLOCK-LOADED")))) + (defun ensure-block-loaded (blockname / lib-datei temp-obj) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (if (not *gf-lib-geladen*) + (progn + (setq lib-datei + (strcat (vl-string-translate "\\" "/" + (getenv "DXFM_DATA")) + "/block_libraries/ils_library.dxf")) + (if (findfile lib-datei) + (progn + (princ "\n Lade ils_library.dxf ...") + (setq temp-obj + (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + lib-datei 1.0 1.0 1.0 0)) + (vla-Delete temp-obj) + (setq *gf-lib-geladen* t) + (princ " OK") + ) + (princ (strcat "\n WARNUNG: Bibliothek nicht gefunden: " + lib-datei)) + ) + ) + ) + ) + ) + ) +) + +;; --- Rohe KS-Extraktion aus Block --- +(if (null (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK-RAW")))) + (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 line-vec line-len axis) + (setq ks-results '()) + (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)) + (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)) + ) + (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)) + ) + ) + ) + ) + (foreach sub-obj sub-entities + (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj)) + ) + ks-results + ) +) + +;; --- KS-Extraktion mit Cache --- +(if (null (car (atoms-family 1 '("EXTRACT-KS-FROM-BLOCK")))) + (defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel) + (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 *gf-ks-cache*)) + (if cached + ;; Aus Cache: relative Koordinaten + Einfuegepunkt + (mapcar '(lambda (item) + (list (car item) + (mapcar '(lambda (pt) + (list (+ (car pt) (car insert-pt)) + (+ (cadr pt) (cadr insert-pt)) + (+ (caddr pt) (caddr insert-pt)))) + (cadr item)))) + (cdr cached)) + (progn + (setq result (extract-ks-from-block-raw block-obj)) + (if result + (progn + (setq ks-rel + (mapcar '(lambda (item) + (list (car item) + (mapcar '(lambda (pt) + (list (- (car pt) (car insert-pt)) + (- (cadr pt) (cadr insert-pt)) + (- (caddr pt) (caddr insert-pt)))) + (cadr item)))) + result)) + (setq *gf-ks-cache* + (cons (cons blockname ks-rel) *gf-ks-cache*)) + ) + ) + result + ) + ) + ) +) + +;; --- Block per KS_EIN/KS_AUS einfuegen --- +(if (null (car (atoms-family 1 '("INSERT-BLOCK-BY-KS")))) + (defun insert-block-by-ks (blockname einfuegepunkt / + block-obj ks-data ks-ein ks-aus offset ausgang) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' fehlt")) + (exit) + ) + ) + (setq block-obj + (vla-InsertBlock modelspace + (vlax-3D-point einfuegepunkt) + blockname 1.0 1.0 1.0 0)) + (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 + (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)) + (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 Z=" (rtos (caddr ausgang) 2 2))) + ausgang + ) + (progn + (princ "\n WARNUNG: KS_EIN/KS_AUS fehlt!") + einfuegepunkt + ) + ) + ) +) + +;; --- Skalierter geneigter Block (Staustrecke, Richtung X) --- +(if (null (car (atoms-family 1 '("INSERT-INCLINED-SCALED-BLOCK")))) + (defun insert-inclined-scaled-block (blockname startpunkt laenge winkel / + rad scale block-obj endpunkt) + (if (<= laenge 0.1) + (progn (princ "\n (Laenge 0 - uebersprungen)") startpunkt) + (progn + (ensure-block-loaded blockname) + (setq scale (/ (float laenge) 1000.0)) + (setq rad (* (float winkel) (/ pi 180.0))) + (setq block-obj + (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname scale 1.0 1.0 0)) + (vla-TransformBy block-obj (vlax-tmatrix + (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-Move block-obj + (vlax-3D-point '(0 0 0)) + (vlax-3D-point startpunkt)) + (setq endpunkt + (list (+ (car startpunkt) (* laenge (cos rad))) + (cadr startpunkt) + (+ (caddr startpunkt) (* (- (sin rad)) laenge)))) + (princ (strcat "\n " blockname " L=" (rtos laenge 2 1) + " -> Z=" (rtos (caddr endpunkt) 2 1))) + endpunkt + ) + ) + ) +) + +;; --- Rotierter Block mit manuellem dx/dz (Richtung X) --- +(if (null (car (atoms-family 1 '("INSERT-ROTATED-BLOCK-WITH-KS")))) + (defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz / + rad block-obj endpunkt) + (ensure-block-loaded blockname) + (setq rad (* (float winkel) (/ pi 180.0))) + (setq block-obj + (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (vla-TransformBy block-obj (vlax-tmatrix + (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-Move block-obj + (vlax-3D-point '(0 0 0)) + (vlax-3D-point startpunkt)) + (list + (+ (car startpunkt) + (+ (* block-dx (cos rad)) (* block-dz (sin rad)))) + (cadr startpunkt) + (+ (caddr startpunkt) + (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz)))) + ) +) + +;; --- Linie/Polylinie-Endpunkte lesen --- +(if (null (car (atoms-family 1 '("GET-LINE-START-END-POINTS")))) + (defun get-line-start-end-points (msg / ent obj obj-name sp ep) + (princ msg) + (setq ent (entsel "\n >> Linie waehlen: ")) + (if ent + (progn + (setq obj (vlax-ename->vla-object (car ent))) + (setq obj-name (vla-get-ObjectName obj)) + (cond + ((= obj-name "AcDbLine") + (setq sp (vlax-safearray->list + (vlax-variant-value (vla-get-StartPoint obj)))) + (setq ep (vlax-safearray->list + (vlax-variant-value (vla-get-EndPoint obj)))) + (princ (strcat "\n 3D-Linie: Z_start=" (rtos (caddr sp) 2 2) + " Z_end=" (rtos (caddr ep) 2 2))) + (list sp ep) + ) + (t (princ "\n Fehler: keine Linie!") nil) + ) + ) + nil + ) + ) +) + +;; --- Bibliothek initialisieren (auch AS/ES-Massen wenn moeglich) --- +(if (null (car (atoms-family 1 '("INIT-BIBLIOTHEK")))) + (defun init-bibliothek ( / lib-datei temp-obj ks-data ks-ein ks-aus) + (if *lib-initialized* + t + (progn + (setq lib-datei + (strcat (vl-string-translate "\\" "/" + (getenv "DXFM_DATA")) + "/block_libraries/ils_library.dxf")) + (if (findfile lib-datei) + (progn + (princ "\n Lade ils_library.dxf ...") + (setq temp-obj + (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + lib-datei 1.0 1.0 1.0 0)) + (vla-Delete temp-obj) + (setq *lib-initialized* t) + (setq *gf-lib-geladen* t) + (princ " OK") + ;; AS/ES-Masse extrahieren falls Block vorhanden + (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 (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) + (if (and ks-ein ks-aus) + (progn + (setq aus-dx (- (caar ks-aus) (caar ks-ein))) + ;; Lokale KS_EIN-Position speichern (Ursprungsrelativ, Block bei (0,0,0)) + (setq *aus-ks-ein-local* (car ks-ein)) + ) + ) + ) + ) + (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 (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) + (if (and ks-ein ks-aus) + (progn + (setq ein-dx (- (caar ks-aus) (caar ks-ein))) + ;; Lokale KS_EIN-Position speichern + (setq *ein-ks-ein-local* (car ks-ein)) + ) + ) + ) + ) + t + ) + (progn + (princ (strcat "\n FEHLER: " lib-datei " nicht gefunden!")) + nil + ) + ) + ) + ) + ) +) + +;; ============================================================ +;; TEIL 3: HZ-ROTATIONS-EINFUEGEFUNKTIONEN (fuer Modus 3) +;; +;; Transformationsmatrix: Rz(hz) * Ry(-vert) +;; [ cos(hz)*cos(v) -sin(hz) cos(hz)*sin(v) 0 ] +;; [ sin(hz)*cos(v) cos(hz) sin(hz)*sin(v) 0 ] +;; [ -sin(v) 0 cos(v) 0 ] +;; [ 0 0 0 1 ] +;; ============================================================ + +;; Staustrecke skaliert mit Hz-Rotation + Gefaelleneigung +;; laenge: Schraeglaenge in mm +;; hz-grad: Horizontalwinkel in Grad (0=+X, CCW) +;; vert-grad: Neigungswinkel in Grad (positiv = abwaerts) +(defun gf-insert-hz-incl-scaled (blockname pt laenge hz-grad vert-grad / + chz shz cv sv scale block-obj endpunkt) + (if (<= laenge 0.1) + (progn (princ "\n (Laenge 0 - uebersprungen)") pt) + (progn + (ensure-block-loaded blockname) + (setq scale (/ (float laenge) 1000.0)) + (setq chz (cos (* (float hz-grad) (/ pi 180.0)))) + (setq shz (sin (* (float hz-grad) (/ pi 180.0)))) + (setq cv (cos (* (float vert-grad) (/ pi 180.0)))) + (setq sv (sin (* (float vert-grad) (/ pi 180.0)))) + (setq block-obj + (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) + blockname scale 1.0 1.0 0)) + (vla-TransformBy block-obj (vlax-tmatrix + (list (list (* chz cv) (- shz) (* chz sv) 0) + (list (* shz cv) chz (* shz sv) 0) + (list (- sv) 0 cv 0) + (list 0 0 0 1)))) + (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point pt)) + (setq endpunkt + (list (+ (car pt) (* laenge chz cv)) + (+ (cadr pt) (* laenge shz cv)) + (+ (caddr pt) (* (- sv) laenge)))) + (princ (strcat "\n HzIncl " blockname + " L=" (rtos laenge 2 0) + " hz=" (rtos hz-grad 2 0) grad-zeichen + " v=" (rtos vert-grad 2 1) grad-zeichen + " -> Z=" (rtos (caddr endpunkt) 2 1))) + endpunkt + ) + ) +) + +;; Block mit Hz + Neigung, Endpunkt per manuellem dx/dz +;; dx: Laenge entlang Vorwaertsrichtung (mm) +;; dz: vertikaler Offset im Block (mm, 0 fuer gerade Bloecke) +(defun gf-insert-hz-with-ks (blockname pt hz-grad vert-grad dx dz / + chz shz cv sv block-obj endpunkt) + (ensure-block-loaded blockname) + (setq chz (cos (* (float hz-grad) (/ pi 180.0)))) + (setq shz (sin (* (float hz-grad) (/ pi 180.0)))) + (setq cv (cos (* (float vert-grad) (/ pi 180.0)))) + (setq sv (sin (* (float vert-grad) (/ pi 180.0)))) + (setq block-obj + (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (vla-TransformBy block-obj (vlax-tmatrix + (list (list (* chz cv) (- shz) (* chz sv) 0) + (list (* shz cv) chz (* shz sv) 0) + (list (- sv) 0 cv 0) + (list 0 0 0 1)))) + (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point pt)) + (setq endpunkt + (list (+ (car pt) (+ (* dx chz cv) (* dz chz sv))) + (+ (cadr pt) (+ (* dx shz cv) (* dz shz sv))) + (+ (caddr pt) (+ (* (- sv) dx) (* cv dz))))) + (princ (strcat "\n HzKS " blockname + " hz=" (rtos hz-grad 2 0) grad-zeichen + " v=" (rtos vert-grad 2 1) grad-zeichen + " -> Z=" (rtos (caddr endpunkt) 2 1))) + endpunkt +) + +;; Gefaellebogen-Block per KS_EIN/KS_AUS einfuegen. +;; Nur Hz-Rotation (vert=0): Block hat eigene 3D-Geometrie fuer die Neigung. +;; hz-grad: Eingangsrichtung in Grad +(defun gf-insert-gefaellebogen-by-ks (blockname pt hz-grad / + chz shz + temp-obj block-obj ks-data ks-ein ks-aus + p-ein p-aus p-ein-rot p-aus-rot + offset ausgang) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' fehlt!")) + (exit) + ) + ) + (setq chz (cos (* (float hz-grad) (/ pi 180.0)))) + (setq shz (sin (* (float hz-grad) (/ pi 180.0)))) + ;; KS-Daten bei hz=0 (Block am Ursprung) + (setq temp-obj + (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (setq ks-data (extract-ks-from-block temp-obj)) + (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) + (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) + ;; Block einfuegen und nur um Z-Achse drehen (Rz) + (setq block-obj + (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (vla-TransformBy block-obj (vlax-tmatrix + (list (list chz (- shz) 0 0) + (list shz chz 0 0) + (list 0 0 1 0) + (list 0 0 0 1)))) + (if (and ks-ein ks-aus) + (progn + (setq p-ein (car ks-ein)) + (setq p-aus (car ks-aus)) + ;; Rz auf KS-Punkte anwenden (Z bleibt unveraendert) + (setq p-ein-rot + (list (- (* chz (car p-ein)) (* shz (cadr p-ein))) + (+ (* shz (car p-ein)) (* chz (cadr p-ein))) + (caddr p-ein))) + (setq p-aus-rot + (list (- (* chz (car p-aus)) (* shz (cadr p-aus))) + (+ (* shz (car p-aus)) (* chz (cadr p-aus))) + (caddr p-aus))) + ;; Block verschieben: rotiertes KS_EIN -> pt + (vla-Move block-obj (vlax-3D-point p-ein-rot) (vlax-3D-point pt)) + (setq offset + (list (- (car pt) (car p-ein-rot)) + (- (cadr pt) (cadr p-ein-rot)) + (- (caddr pt) (caddr p-ein-rot)))) + (setq ausgang + (list (+ (car p-aus-rot) (car offset)) + (+ (cadr p-aus-rot) (cadr offset)) + (+ (caddr p-aus-rot) (caddr offset)))) + (princ (strcat "\n Gefaellebogen " blockname + " hz=" (rtos hz-grad 2 0) grad-zeichen + " -> Z=" (rtos (caddr ausgang) 2 1))) + ausgang + ) + (progn + (princ (strcat "\n WARNUNG: KS fehlt in '" blockname "'")) + pt + ) + ) +) + +;; ============================================================ +;; TEIL 4: MODUS 3 - LINIENZUG-ANALYSE +;; ============================================================ + +;; Horizontalwinkel von p1 nach p2 (Grad, 0=+X, CCW positiv) +(defun gf-hz-winkel (p1 p2) + (* (atan (- (cadr p2) (cadr p1)) + (- (car p2) (car p1))) + (/ 180.0 pi))) + +;; 2D-Abstand (XY-Ebene) +(defun gf-abstand-2d (p1 p2) + (sqrt (+ (* (- (car p2) (car p1)) (- (car p2) (car p1))) + (* (- (cadr p2) (cadr p1)) (- (cadr p2) (cadr p1)))))) + +;; Bogensweep (Grad, positiv) -> naechster Gefaellebogen-Winkel +(defun gf-snap-bogenwinkel (d) + (cond ((< d 45) 30) + ((< d 75) 60) + (t 90))) + +;; Blockname fuer Gefaellebogen +(defun gf-bogen-blockname (bwinkel bseite) + (strcat "Gefaellebogen_" bseite "_" (itoa bwinkel) grad-zeichen "_R500")) + +;; dx und dz eines Gefaellebogen-Blocks extrahieren (KS_EIN -> KS_AUS) +;; Rueckgabe: (dx dz) dx = horizontale, dz = vertikale Verschiebung +(defun gf-bogen-masse (bwinkel bseite / + blockname temp-obj ks-data + ks-ein-pos ks-aus-pos dx dz) + (setq blockname (gf-bogen-blockname bwinkel bseite)) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n WARNUNG: " blockname " fehlt - Nullwerte")) + '(0 0) + ) + (progn + (setq temp-obj + (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) + blockname 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 (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + (princ (strcat "\n " blockname + ": dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1))) + (list dx dz) + ) + (progn + (princ (strcat "\n WARNUNG: KS fehlt in " blockname)) + '(0 0) + ) + ) + ) + ) +) + +;; Verbundene Objektkette sortieren ab startpunkt. +;; Rueckgabe: Liste von (obj sp ep umgekehrt) +;; umgekehrt=t wenn Objekt rueckwaerts traversiert wird +(defun gf-sortiere-objekte (obj-liste startpunkt / + kette aktuell rest + best best-d best-sp best-ep best-umk + item objname sp ep d1 d2) + (setq kette '()) + (setq aktuell startpunkt) + (setq rest obj-liste) + (while rest + (setq best nil best-d 1e99) + (foreach item rest + (setq objname (vla-get-ObjectName item)) + (if (or (= objname "AcDbLine") (= objname "AcDbArc")) + (progn + (setq sp (vlax-safearray->list + (vlax-variant-value (vla-get-StartPoint item)))) + (setq ep (vlax-safearray->list + (vlax-variant-value (vla-get-EndPoint item)))) + (setq d1 (gf-abstand-2d aktuell sp)) + (setq d2 (gf-abstand-2d aktuell ep)) + (if (< d1 best-d) + (setq best item best-d d1 + best-sp sp best-ep ep best-umk nil) + ) + (if (< d2 best-d) + (setq best item best-d d2 + best-sp ep best-ep sp best-umk t) + ) + ) + ) + ) + (if best + (progn + (setq kette + (append kette (list (list best best-sp best-ep best-umk)))) + (setq aktuell best-ep) + (setq rest (vl-remove best rest)) + ) + (progn + (princ "\n WARNUNG: Kette unterbrochen!") + (setq rest nil) + ) + ) + ) + kette +) + +;; Kette analysieren -> Segment-Daten +;; Segment: (typ hz-eingang laenge-2d bogen-winkel seite) +;; typ: "Linie" oder "Bogen" +;; hz-eingang: Horizontalwinkel bei Eintritt (Grad) +;; laenge-2d: 2D XY-Laenge (fuer LINE), Sehnenmass (fuer ARC) +;; bogen-winkel: 30/60/90 (nur fuer Bogen) +;; seite: "links"/"rechts" (nur fuer Bogen) +(defun gf-analysiere-kette (kette / + segmente item obj objname sp ep umk + hz start-a end-a sweep delta + bwinkel bseite prev-hz) + (setq segmente '()) + (setq prev-hz nil) + (foreach item kette + (setq obj (car item)) + (setq sp (cadr item)) + (setq ep (caddr item)) + (setq umk (nth 3 item)) + (setq objname (vla-get-ObjectName obj)) + (cond + ((= objname "AcDbLine") + (setq hz (gf-hz-winkel sp ep)) + (setq segmente + (append segmente + (list (list "Linie" hz (gf-abstand-2d sp ep) 0 "links")))) + (setq prev-hz hz) + ) + ((= objname "AcDbArc") + ;; Sweep des Bogens in Grad (immer positiv, CCW) + (setq start-a (vla-get-StartAngle obj)) + (setq end-a (vla-get-EndAngle obj)) + (if (>= end-a start-a) + (setq sweep (* (- end-a start-a) (/ 180.0 pi))) + (setq sweep (* (+ (* 2 pi) (- end-a start-a)) (/ 180.0 pi))) + ) + ;; Traversierungsrichtung: vorwaerts=CCW=Linkskurve, rueckwaerts=CW=Rechtskurve + (if umk + (setq delta (- sweep)) + (setq delta sweep) + ) + (setq bwinkel (gf-snap-bogenwinkel (abs delta))) + (setq bseite (if (>= delta 0) "links" "rechts")) + ;; Eingangsrichtung: vorheriger Richtungswinkel (oder Chord-Winkel) + (setq hz (if prev-hz prev-hz (gf-hz-winkel sp ep))) + (setq segmente + (append segmente + (list (list "Bogen" hz (gf-abstand-2d sp ep) bwinkel bseite)))) + ;; Ausgangsrichtung nach dem Bogen + (setq prev-hz + (+ hz (* (if (>= delta 0) 1.0 -1.0) (float bwinkel)))) + ) + ) + ) + segmente +) + +;; Gefaellewinkel (Grad) aus Segmentliste und deltaH berechnen. +;; deltaH: positiver Hoehenunterschied in mm (Gesamt-Abfall) +;; extra-sep: zusaetzliche Separatoren ausserhalb der Bogen (z.B. 1 vor EIN-Element) +;; Formel: deltaH = (L_gerade + (n_bogen+extra_sep)*300) * sin(alpha) + sum(|dz_bogen|) +(defun gf-winkel-berechnen (segmente deltaH extra-sep / + L-gerade sum-dz-bogen n-bogen + seg bwinkel bseite masse sin-alpha alpha) + (setq L-gerade 0.0 sum-dz-bogen 0.0 n-bogen 0) + (foreach seg segmente + (if (= (car seg) "Linie") + (setq L-gerade (+ L-gerade (caddr seg))) + (progn + (setq bwinkel (nth 3 seg) bseite (nth 4 seg)) + (setq masse (gf-bogen-masse bwinkel bseite)) + (setq sum-dz-bogen (+ sum-dz-bogen (abs (cadr masse)))) + (setq n-bogen (1+ n-bogen)) + ) + ) + ) + ;; Separator (300mm): je einen vor jedem Bogen + extra-sep weitere + (setq L-gerade (+ L-gerade (* (+ (float n-bogen) (float extra-sep)) 300.0))) + (princ (strcat "\n Gerade + Separatoren: " (rtos L-gerade 2 1) " mm")) + (princ (strcat "\n Bogen-dZ gesamt: " (rtos sum-dz-bogen 2 1) " mm")) + (princ (strcat "\n Resthoehe fuer Grade: " + (rtos (- (float deltaH) sum-dz-bogen) 2 1) " mm")) + (cond + ((<= L-gerade 0.1) + (princ "\n WARNUNG: keine geraden Strecken -> Fallback 3 Grad") + 3.0) + ((< (- (float deltaH) sum-dz-bogen) 0) + (princ "\n WARNUNG: Bogen-dZ > deltaH -> Fallback 1 Grad") + 1.0) + (t + (setq sin-alpha + (/ (- (float deltaH) sum-dz-bogen) L-gerade)) + (if (> sin-alpha 1.0) (setq sin-alpha 1.0)) + (setq alpha (* (asin sin-alpha) (/ 180.0 pi))) + (princ (strcat "\n>>> Berechneter Gefaellewinkel: " + (rtos alpha 2 3) grad-zeichen)) + alpha + ) + ) +) + +;; Alle Segmente des Linienzugs einfuegen. +;; segmente: Ergebnis von gf-analysiere-kette +;; grade: Gefaellewinkel in Grad +;; startpunkt: 3D-Einfuegepunkt des ersten Blocks +;; +;; Reihenfolge bei Bogen: +;; ... Staustrecke (Linie) → Separator am Ende der Linie → Gefaellebogen ... +(defun gf-linienzug-einfuegen (segmente grade startpunkt / + aktuell i n seg naechstes + typ hz laenge bwinkel bseite blockname) + (setq aktuell startpunkt) + (setq n (length segmente)) + (setq i 0) + (while (< i n) + (setq seg (nth i segmente)) + (setq naechstes (if (< (1+ i) n) (nth (1+ i) segmente) nil)) + (setq typ (car seg)) + (setq hz (cadr seg)) + (setq laenge (caddr seg)) + (setq bwinkel (nth 3 seg)) + (setq bseite (nth 4 seg)) + (cond + ((= typ "Linie") + (princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n) + ": Staustrecke L=" (rtos laenge 2 1) " mm" + " hz=" (rtos hz 2 1) grad-zeichen + " v=" (rtos grade 2 2) grad-zeichen)) + (setq aktuell + (gf-insert-hz-incl-scaled + "Staustrecke_SP_1000_mm" aktuell laenge hz grade)) + ;; Separator am Ende dieser Linie, falls naechstes Segment ein Bogen ist + (if (and naechstes (= (car naechstes) "Bogen")) + (progn + (princ (strcat "\n\n" (itoa (1+ i)) "S/" (itoa n) + ": Separator 300mm (vor Bogen)" + " hz=" (rtos hz 2 1) grad-zeichen + " v=" (rtos grade 2 2) grad-zeichen)) + (setq aktuell + (gf-insert-hz-with-ks + "Staustrecke_Separator_SP_300_mm" aktuell hz grade 300 0)) + ) + ) + ) + ((= typ "Bogen") + (setq blockname (gf-bogen-blockname bwinkel bseite)) + ;; Gefaellebogen (nur Hz-Rotation, Block hat eigene 3D-Geometrie) + (princ (strcat "\n\n" (itoa (1+ i)) "/" (itoa n) + ": " blockname + " hz=" (rtos hz 2 1) grad-zeichen)) + (setq aktuell + (gf-insert-gefaellebogen-by-ks blockname aktuell hz)) + ) + ) + (setq i (1+ i)) + ) + (princ "\n\n=========================================") + (princ "\n>>> Linienzug-Gefaellestrecke eingefuegt! <<<") + (princ "\n=========================================") + aktuell +) + +;; Listenelement an Position idx durch val ersetzen. +(defun gf-replace-nth (lst idx val / i result) + (setq result '() i 0) + (foreach item lst + (setq result (append result (list (if (= i idx) val item)))) + (setq i (1+ i)) + ) + result +) + +;; Ausgangsrichtung (hz in Grad) nach dem letzten Segment berechnen. +;; Fuer Linie: hz des Segments; fuer Bogen: hz-eingang +/- bwinkel. +(defun gf-exit-hz (segmente / i n seg bseite prev-hz) + (setq prev-hz 0.0 n (length segmente) i 0) + (while (< i n) + (setq seg (nth i segmente)) + (cond + ((= (car seg) "Linie") + (setq prev-hz (cadr seg))) + ((= (car seg) "Bogen") + (setq bseite (nth 4 seg)) + (setq prev-hz (+ (cadr seg) + (* (if (= bseite "links") 1.0 -1.0) + (float (nth 3 seg)))))) + ) + (setq i (1+ i)) + ) + prev-hz +) + +;; Hauptfunktion Modus 3 +(defun gf-linienzug-modus ( / + ss n i j obj obj-liste kette segmente seg + startpunkt endpunkt-ref deltaH grade antwort idx + as-seite es-seite as-block es-block + entry-hz exit-hz + first-idx last-idx neu-l + chz shz as-target + aktuell-pt) + (princ "\n\n>>> MODUS 3: Linienzug auswaehlen <<<") + (princ "\nBitte alle Linien (LINE) und Boegen (ARC) des Pfades auswaehlen,") + (princ "\ndann ENTER druecken:") + + ;; Selektion + (setq ss (ssget (list (cons 0 "LINE,ARC")))) + (if (null ss) + (progn (princ "\nKeine Objekte ausgewaehlt!") (exit)) + ) + (setq n (sslength ss)) + (princ (strcat "\n " (itoa n) " Objekte ausgewaehlt.")) + + ;; Objekte in Liste + (setq obj-liste '() i 0) + (while (< i n) + (setq obj (vlax-ename->vla-object (ssname ss i))) + (setq obj-liste (append obj-liste (list obj))) + (setq i (1+ i)) + ) + + ;; Startpunkt: gleichzeitig Kettenanfang (Sortierung) UND Einfuegepunkt AUS-Element + (setq startpunkt + (getpoint "\nStartpunkt (3D) waehlen - AUS-Element / Kettenanfang: ")) + (if (null startpunkt) + (progn (princ "\nKein Startpunkt!") (exit)) + ) + + ;; Endpunkt: Z-Koordinate fuer deltaH-Berechnung + (setq endpunkt-ref + (getpoint "\nEndpunkt (3D) waehlen - EIN-Element / Kettenende: ")) + (if (null endpunkt-ref) + (progn (princ "\nKein Endpunkt!") (exit)) + ) + + ;; DeltaH aus Z-Koordinaten + (setq deltaH (abs (- (caddr startpunkt) (caddr endpunkt-ref)))) + (princ (strcat "\n DeltaH aus 3D-Punkten: " (rtos deltaH 2 1) " mm")) + + ;; Kette sortieren + (princ "\n Sortiere Segmente ...") + (setq kette (gf-sortiere-objekte obj-liste startpunkt)) + (if (null kette) + (progn (alert "Keine verbundene Kette gefunden!") (exit)) + ) + (princ (strcat " " (itoa (length kette)) " Segmente gefunden.")) + + ;; Segmente analysieren + (setq segmente (gf-analysiere-kette kette)) + + ;; Eingangs- und Ausgangsrichtung bestimmen + (setq entry-hz (cadr (car segmente))) + (setq exit-hz (gf-exit-hz segmente)) + + ;; Seite fuer AUS-Element (vor Winkelberechnung, da Laengenanpassung davon abhaengt) + (princ "\n\nAUS-Element (_3D_AS_90_*) - Seite waehlen:") + (princ "\n 1 - Links") + (princ "\n 2 - Rechts") + (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) + (setq as-seite (if (= antwort "2") "rechts" "links")) + + ;; Seite fuer EIN-Element + (princ "\n\nEIN-Element (_3D_ES_90_*) - Seite waehlen:") + (princ "\n 1 - Links") + (princ "\n 2 - Rechts") + (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) + (setq es-seite (if (= antwort "2") "rechts" "links")) + + (setq as-block (strcat "_3D_AS_90_" as-seite)) + (setq es-block (strcat "_3D_ES_90_" es-seite)) + + ;; Segmentlaengen anpassen. + ;; Die gezeichneten Linien enthalten die Laengen von AUS-/EIN-Element UND Separatoren. + ;; Abzugsregel pro LINE-Segment: + ;; Erstes LINE-Segment: - aus-dx + ;; LINE gefolgt von BOGEN: - 300 mm (Separator vor Bogen) + ;; Letztes LINE-Segment: - 300 mm (Separator vor EIN) - ein-dx + (setq first-idx -1 j 0) + (while (and (< j (length segmente)) (< first-idx 0)) + (if (= (car (nth j segmente)) "Linie") (setq first-idx j)) + (setq j (1+ j)) + ) + (setq last-idx -1 j (1- (length segmente))) + (while (and (>= j 0) (< last-idx 0)) + (if (= (car (nth j segmente)) "Linie") (setq last-idx j)) + (setq j (1- j)) + ) + (if (>= first-idx 0) + (progn + (setq i 0) + (while (< i (length segmente)) + (setq seg (nth i segmente)) + (if (= (car seg) "Linie") + (progn + (setq neu-l (caddr seg)) + ;; Erstes LINE-Segment: AUS-Element abziehen + (if (= i first-idx) (setq neu-l (- neu-l aus-dx))) + ;; Naechstes Segment ist BOGEN: Separator (300 mm) abziehen + (if (and (< (1+ i) (length segmente)) + (= (car (nth (1+ i) segmente)) "Bogen")) + (setq neu-l (- neu-l 300.0)) + ) + ;; Letztes LINE-Segment: Separator vor EIN (300 mm) + EIN-Element abziehen + (if (= i last-idx) (setq neu-l (- neu-l 300.0 ein-dx))) + (setq neu-l (max 100.0 neu-l)) + (setq segmente (gf-replace-nth segmente i + (list (car seg) (cadr seg) neu-l (nth 3 seg) (nth 4 seg)))) + ) + ) + (setq i (1+ i)) + ) + ) + ) + + ;; Segmente nach Laengenanpassung anzeigen + (princ "\n\n--- Segment-Analyse (Laengen nach Kuerzung) ---") + (setq idx 0) + (foreach seg segmente + (setq idx (1+ idx)) + (if (= (car seg) "Linie") + (princ (strcat "\n " (itoa idx) ". Linie L=" (rtos (caddr seg) 2 1) + " mm hz=" (rtos (cadr seg) 2 1) grad-zeichen)) + (princ (strcat "\n " (itoa idx) ". Bogen " (itoa (nth 3 seg)) + grad-zeichen " " (nth 4 seg) + " hz-Eingang=" (rtos (cadr seg) 2 1) grad-zeichen)) + ) + ) + (princ (strcat "\n Seg " (itoa (1+ first-idx)) " (1. Linie): -" (rtos aus-dx 2 1) " mm (AUS-Element)")) + (princ "\n Jede Linie vor Bogen: -300 mm (Bogen-Separator)") + (princ (strcat "\n Seg " (itoa (1+ last-idx)) " (letzte Linie): -300 mm (EIN-Sep) -" (rtos ein-dx 2 1) " mm (EIN-Element)")) + (princ (strcat "\n Eintrittsrichtung: " (rtos entry-hz 2 1) grad-zeichen)) + (princ (strcat "\n Austrittsrichtung: " (rtos exit-hz 2 1) grad-zeichen)) + + ;; Gefaellewinkel berechnen (1 Extra-Separator vor EIN-Element) + (princ "\n\n Berechne Gefaellewinkel aus Geometrie ...") + (setq grade (gf-winkel-berechnen segmente deltaH 1)) + + ;; Manuelle Anpassung + (setq antwort + (getstring (strcat "\nBerechneten Winkel " + (rtos grade 2 3) grad-zeichen + " verwenden? (j/n) [j]: "))) + (if (= (strcase antwort) "N") + (progn + (setq grade (getreal "\nGefaellewinkel (Grad): ")) + (if (or (null grade) (<= grade 0)) (setq grade 3.0)) + ) + ) + (setq grade (float grade)) + + ;; Zusammenfassung + (princ "\n\n=========================================") + (princ (strcat "\n>>> Segmente: " (itoa (length segmente)))) + (princ (strcat "\n>>> DeltaH: " (rtos deltaH 2 1) " mm")) + (princ (strcat "\n>>> Gefaellewinkel: " (rtos grade 2 3) grad-zeichen)) + (princ (strcat "\n>>> Eintrittswinkel: " (rtos entry-hz 2 1) grad-zeichen)) + (princ (strcat "\n>>> Austrittswinkel: " (rtos exit-hz 2 1) grad-zeichen)) + (princ (strcat "\n>>> AUS-Element: " as-block)) + (princ (strcat "\n>>> EIN-Element: " es-block)) + (princ "\n=========================================") + + ;; Bestaetigung + (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: ")) + (if (not (= antwort "2")) + (progn + ;; AUS-Element: Block-Ursprung an startpunkt ausrichten. + ;; KS_EIN liegt im Block seitlich (Delta-Y = Drehteller-Anschluss). + ;; Damit KS_AUS auf der gezeichneten Linie liegt, muss der Einfuegepunkt + ;; um Rz(entry-hz) * ks_ein_local gegenueber startpunkt verschoben werden. + (setq chz (cos (* entry-hz (/ pi 180.0)))) + (setq shz (sin (* entry-hz (/ pi 180.0)))) + (if *aus-ks-ein-local* + (setq as-target + (list (+ (car startpunkt) + (- (* chz (car *aus-ks-ein-local*)) + (* shz (cadr *aus-ks-ein-local*)))) + (+ (cadr startpunkt) + (+ (* shz (car *aus-ks-ein-local*)) + (* chz (cadr *aus-ks-ein-local*)))) + (+ (caddr startpunkt) + (caddr *aus-ks-ein-local*)))) + (setq as-target startpunkt) + ) + (princ (strcat "\n\n>>> AUS-Element: " as-block + " (hz=" (rtos entry-hz 2 1) grad-zeichen ")")) + (setq aktuell-pt (gf-insert-gefaellebogen-by-ks as-block as-target entry-hz)) + + ;; Linienzug mit Gefaellebogen und Separatoren (gekuerzte Laengen) + (setq aktuell-pt (gf-linienzug-einfuegen segmente grade aktuell-pt)) + + ;; Separator vor EIN-Element + (princ "\n>>> Separator vor EIN-Element") + (setq aktuell-pt + (gf-insert-hz-with-ks "Staustrecke_Separator_SP_300_mm" + aktuell-pt exit-hz grade 300 0)) + + ;; EIN-Element mit Austrittsrichtung ausrichten (Rz um exit-hz) + (princ (strcat "\n>>> EIN-Element: " es-block + " (hz=" (rtos exit-hz 2 1) grad-zeichen ")")) + (gf-insert-gefaellebogen-by-ks es-block aktuell-pt exit-hz) + + (princ "\n\n=========================================") + (princ "\n>>> Fertig! <<<") + (princ "\n=========================================") + ) + (princ "\nAbgebrochen.") + ) +) + +;; ============================================================ +;; TEIL 5: MODUS 1+2 - EINFACHE GEFAELLESTRECKE ;; ============================================================ (defun gefaellestrecke-einfuegen (L_stau winkel startpunkt seite / - aktueller-punkt as-block es-block tilt-winkel endpunkt) - + aktueller-punkt as-block es-block endpunkt) (setq aktueller-punkt startpunkt) (setq as-block (strcat "_3D_AS_90_" seite)) (setq es-block (strcat "_3D_ES_90_" seite)) - ;; Richtung immer Ab (abwaerts) – positiver Winkel = Gefaelle nach unten - (setq tilt-winkel winkel) - (if (not *lib-initialized*) (init-bibliothek)) - ;; 1/4 AUS-Element - (princ (strcat "\n\n1/4: " as-block " (0°)")) + (princ (strcat "\n\n1/4: " as-block)) (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt)) - ;; 2/4 Staustrecke_SP_1000_mm (skaliert) - (princ (strcat "\n\n2/4: Staustrecke_SP_1000_mm (" - (itoa winkel) grad-zeichen - ", Laenge=" (rtos L_stau 2 2) " mm)")) + (princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1) + " mm " (itoa winkel) grad-zeichen)) (setq aktueller-punkt - (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_stau tilt-winkel)) + (insert-inclined-scaled-block + "Staustrecke_SP_1000_mm" aktueller-punkt L_stau winkel)) - ;; 3/4 Staustrecke_Separator_SP_300_mm - (princ (strcat "\n\n3/4: Staustrecke_Separator_SP_300_mm (" - (itoa winkel) grad-zeichen ")")) + (princ (strcat "\n\n3/4: Separator 300mm " (itoa winkel) grad-zeichen)) (setq aktueller-punkt - (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" - aktueller-punkt tilt-winkel 300 0)) + (insert-rotated-block-with-ks + "Staustrecke_Separator_SP_300_mm" aktueller-punkt winkel 300 0)) - ;; 4/4 EIN-Element - (princ (strcat "\n\n4/4: " es-block " (0°)")) + (princ (strcat "\n\n4/4: " es-block)) (setq endpunkt (insert-block-by-ks es-block aktueller-punkt)) (princ "\n\n=========================================") (princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<") (princ "\n=========================================") - endpunkt ) ;; ============================================================ -;; TEIL 2: HAUPTFUNKTION +;; TEIL 6: HAUPTBEFEHL ;; ============================================================ -(defun c:GEFAELLESTRECKE ( / deltaL winkel rad L_stau sep-x antwort seite - eingabe-modus line-points startpunkt endpunkt - differenz deltaX deltaY - startpunkt-fuer-einfuegen) +(defun c:GEFAELLESTRECKE ( / antwort eingabe-modus deltaL winkel rad L_stau sep-x seite + line-points startpunkt endpunkt differenz + deltaX deltaY startpunkt-fuer-einfuegen) (princ "\n=========================================") - (princ "\n GEFAELLESTRECKE GENERATOR v1.0") + (princ "\n GEFAELLESTRECKE GENERATOR v2.0") (princ "\n Richtung: immer AB (nach unten)") (princ "\n=========================================") - ;; Bibliothek initialisieren (aus VarioFoerderer.lsp) + ;; Bibliothek initialisieren (if (not (init-bibliothek)) (progn - (alert "Fehler beim Initialisieren der Bibliothek!\nBitte Pfade pruefen.") + (alert "Fehler beim Initialisieren der Bibliothek!\nBitte DXFM_DATA pruefen.") (exit) ) ) - ;; --- Eingabemodus --- + ;; Eingabemodus (princ "\n\nEingabemodus waehlen:") - (princ "\n 1 - Werte manuell eingeben") - (princ "\n 2 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)") - (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) - (if (= antwort "2") - (setq eingabe-modus "Linie") - (setq eingabe-modus "Manuell") - ) + (princ "\n 1 - Werte manuell eingeben (einfache Strecke)") + (princ "\n 2 - 3D-Linie auswaehlen (einfache Strecke)") + (princ "\n 3 - Linienzug (LINE + ARC) auswaehlen mit Gefaellebogen") + (setq antwort (getstring "\nIhre Wahl (1/2/3) [1]: ")) - ;; --- Modus 1: Manuelle Eingabe --- - (if (= eingabe-modus "Manuell") - (progn - (princ "\n\n>>> MODUS: Manuelle Werteingabe <<<") - (setq startpunkt-fuer-einfuegen (getpoint "\nStartpunkt fuer AUS_Element waehlen: ")) - (if (null startpunkt-fuer-einfuegen) (setq startpunkt-fuer-einfuegen '(0 0 0))) - (setq deltaL (getreal "\nAbstand ΔL (mm): ")) - (if (or (null deltaL) (<= deltaL 0)) (setq deltaL (ssg-cfg-or "gefaelle" "default_delta_l" 5000.0))) + (cond + ;; Modus 3: Linienzug mit Bogen + ((= antwort "3") + (gf-linienzug-modus) ) - ;; --- Modus 2: 3D-Linie --- - (progn - (princ "\n\n>>> MODUS: 3D-Linie auswaehlen <<<") - (command "BKS" "W") - (princ "\n ✓ BKS auf Weltkoordinaten gesetzt") - (setq line-points - (get-line-start-end-points - "\nBitte 3D-Linie fuer die Gefaellestrecke auswaehlen:")) - (if (null line-points) - (progn (alert "Keine gueltige Linie ausgewaehlt!") (exit)) - ) + ;; Modus 1+2: einfache Gefaellestrecke + (t + (if (= antwort "2") + (setq eingabe-modus "Linie") + (setq eingabe-modus "Manuell") + ) - (setq startpunkt (car line-points)) - (setq endpunkt (cadr line-points)) + ;; Modus 1: Manuelle Eingabe + (if (= eingabe-modus "Manuell") + (progn + (princ "\n\n>>> MODUS 1: Manuelle Werteingabe <<<") + (setq startpunkt-fuer-einfuegen + (getpoint "\nStartpunkt fuer AUS_Element waehlen: ")) + (if (null startpunkt-fuer-einfuegen) + (setq startpunkt-fuer-einfuegen '(0 0 0))) + (setq deltaL (getreal "\nAbstand deltaL (mm): ")) + (if (or (null deltaL) (<= deltaL 0)) + (setq deltaL (ssg-cfg-or "gefaelle" "default_delta_l" 5000.0))) + ) + ;; Modus 2: 3D-Linie + (progn + (princ "\n\n>>> MODUS 2: 3D-Linie auswaehlen <<<") + (command "BKS" "W") + (princ "\n BKS auf Weltkoordinaten gesetzt.") + (setq line-points + (get-line-start-end-points + "\nBitte 3D-Linie fuer die Gefaellestrecke auswaehlen:")) + (if (null line-points) + (progn (alert "Keine gueltige Linie ausgewaehlt!") (exit)) + ) + (setq startpunkt (car line-points) + endpunkt (cadr line-points)) + (setq differenz (punkt-differenz startpunkt endpunkt)) + (setq deltaX (abs (car differenz)) + deltaY (abs (cadr differenz))) + (setq deltaL (max deltaX deltaY)) + (princ (strcat "\n deltaX=" (rtos deltaX 2 2) + " mm, deltaY=" (rtos deltaY 2 2) " mm")) + (princ (strcat "\n deltaL = " (rtos deltaL 2 2) " mm")) + (setq startpunkt-fuer-einfuegen startpunkt) + ) + ) - (setq differenz (punkt-differenz startpunkt endpunkt)) - (setq deltaX (abs (car differenz))) - (setq deltaY (abs (cadr differenz))) - (setq deltaL (max deltaX deltaY)) + (princ "\n\n=========================================") + (princ (strcat "\n deltaL = " (rtos deltaL 2 2) " mm")) + (princ "\n=========================================") - (princ (strcat "\n → ΔX=" (rtos deltaX 2 2) " mm, ΔY=" (rtos deltaY 2 2) " mm")) - (princ (strcat "\n → ΔL = " (rtos deltaL 2 2) " mm")) + ;; Winkelabfrage + (setq winkel (getreal "\n\nGefaellewinkel (Grad) [3]: ")) + (if (or (null winkel) (<= winkel 0)) + (setq winkel (ssg-cfg-or "gefaelle" "default_winkel" 3.0))) + (setq winkel (float winkel)) + (setq rad (* winkel (/ pi 180.0))) + (princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen)) - (setq startpunkt-fuer-einfuegen startpunkt) + ;; Seite waehlen + (princ "\n\nEin-/Auselement - Seite waehlen:") + (princ "\n 1 - Links (_3D_AS_90_links / _3D_ES_90_links)") + (princ "\n 2 - Rechts (_3D_AS_90_rechts / _3D_ES_90_rechts)") + (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) + (if (= antwort "2") (setq seite "rechts") (setq seite "links")) + (princ (strcat "\n>>> Seite: " seite)) + + ;; Laengenberechnung + ;; deltaL = aus_dx + L_stau*cos(rad) + sep*cos(rad) + ein_dx + (setq sep-x (* (ssg-cfg-or "gefaelle" "separator_breite" 300.0) (cos rad))) + (setq L_stau (/ (- deltaL aus-dx ein-dx sep-x) (cos rad))) + + ;; Validierung + (if (<= L_stau 0.1) + (progn + (alert (strcat "Berechnete Staustreckenlaenge ungueltig: " + (rtos L_stau 2 2) " mm\n" + "Bitte groesseres deltaL oder kleineren Winkel waehlen.")) + (exit) + ) + ) + + ;; Zusammenfassung + (princ "\n\n=========================================") + (princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen)) + (princ (strcat "\n>>> Seite: " seite)) + (princ (strcat "\n>>> L_stau: " (rtos L_stau 2 2) " mm")) + (princ "\n=========================================") + + ;; Bestaetigung + (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: ")) + (if (not (= antwort "2")) + (gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen seite) + (princ "\nAbgebrochen.") + ) ) ) - - (princ "\n\n=========================================") - (princ (strcat "\n ΔL = " (rtos deltaL 2 2) " mm")) - (princ "\n=========================================") - - ;; --- Winkelabfrage --- - (setq winkel (getreal "\n\nGefaellewinkel (°) [3]: ")) - (if (or (null winkel) (<= winkel 0)) (setq winkel (ssg-cfg-or "gefaelle" "default_winkel" 3.0))) - (setq winkel (float winkel)) - (setq rad (* winkel (/ pi 180.0))) - (princ (strcat "\n>>> Gewaehlter Winkel: " (rtos winkel 2 1) grad-zeichen)) - - ;; --- Seite abfragen --- - (princ "\n\nEin-/Auselement - Seite waehlen:") - (princ "\n 1 - Links (_3D_AS_90_links / _3D_ES_90_links)") - (princ "\n 2 - Rechts (_3D_AS_90_rechts / _3D_ES_90_rechts)") - (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) - (if (= antwort "2") - (setq seite "rechts") - (setq seite "links") - ) - (princ (strcat "\n>>> Seite: " seite)) - - ;; --- Laengenberechnung --- - ;; Horizontalbilanz: deltaL = aus_dx + L_stau*cos(rad) + 300*cos(rad) + ein_dx - ;; L_stau (Weglaenge) = (deltaL - aus_dx - ein_dx - 300*cos(rad)) / cos(rad) - (setq sep-x (* (ssg-cfg-or "gefaelle" "separator_breite" 300.0) (cos rad))) - (setq L_stau (/ (- deltaL aus-dx ein-dx sep-x) (cos rad))) - - ;; --- Validierung --- - (if (<= L_stau 0.1) - (progn - (alert (strcat "Berechnete Staustreckenlaenge ungueltig: " - (rtos L_stau 2 2) " mm\n" - "Bitte groessere ΔL oder kleineren Winkel waehlen.")) - (exit) - ) - ) - - ;; --- Ausgabe Zusammenfassung --- - (princ "\n\n=========================================") - (princ (strcat "\n>>> Gewaehlter Winkel: " (rtos winkel 2 1) grad-zeichen)) - (princ (strcat "\n>>> Seite: " seite)) - (princ (strcat "\n>>> L_stau (Weglaenge): " (rtos L_stau 2 2) " mm")) - (princ (strcat "\n>>> Separator Horiz.: " (rtos sep-x 2 2) " mm")) - (princ "\n=========================================") - - ;; --- Bestaetigungsdialog --- - (princ "\n\nGefaellestrecke einfuegen?") - (princ "\n 1 - Ja, einfuegen") - (princ "\n 2 - Nein, abbrechen") - (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) - - (if (not (= antwort "2")) - (gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen seite) - (princ "\nVorgang abgebrochen.") - ) - nil ) @@ -192,5 +1254,10 @@ ;; START ;; ============================================================ (princ "\n=========================================") -(princ "\n>>> GEFAELLESTRECKE v1.0 geladen <<<") +(princ "\n>>> GEFAELLESTRECKE v2.0 geladen <<<") (princ "\n>>> Befehl: GEFAELLESTRECKE <<<") +(princ "\n Modus 1: Manuelle Eingabe") +(princ "\n Modus 2: 3D-Linie") +(princ "\n Modus 3: Linienzug mit Gefaellebogen") +(princ "\n=========================================") +(princ) diff --git a/Lisp/KreiselInsert.lsp b/Lisp/KreiselInsert.lsp index 6d9d958..8a66dfe 100644 --- a/Lisp/KreiselInsert.lsp +++ b/Lisp/KreiselInsert.lsp @@ -16,19 +16,19 @@ (setq #Eckrad_LetzteNr 0) ) -;; Block-Pfad +;; Block-Pfad (gesetzt durch bin/setenv.bat -> DXFM_BLOCKS = data\ils\2D) (setq block-pfad (getenv "DXFM_BLOCKS")) (if (or (null block-pfad) (= block-pfad "")) (progn - (setq block-pfad "C:/Users/y.wang/Documents/dxfmakros/Blocks/") - (alert (strcat "Umgebungsvariable DXFM_BLOCKS nicht gefunden.\nNutze Standardpfad: " block-pfad)) + (alert "DXFM_BLOCKS nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.") + (exit) ) (setq block-pfad (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" block-pfad)) "/")) ) (setq *block-path* block-pfad) -(princ (strcat "\nBlock-Pfad aktiv: " block-pfad)) +(princ (strcat "\nBlock-Pfad: " block-pfad)) ;; Kreisel-Geometrie-Konstanten (aus Config oder Fallback) (setq *kreisel-durchmesser* (ssg-cfg-or "kreisel" "durchmesser" 800.0)) diff --git a/Lisp/VarioFoerderer.lsp b/Lisp/VarioFoerderer.lsp index a888a68..7790132 100644 --- a/Lisp/VarioFoerderer.lsp +++ b/Lisp/VarioFoerderer.lsp @@ -1,1369 +1,8 @@ ;; ============================================================ -;; FÖRDERANLAGE GENERATOR für BricsCAD Pro -;; Version: 25.0 (Komplett bibliotheksbasiert, keine Fallbacks) -;; Befehl: VarioFoerderer +;; VarioFoerderer.lsp — Kompatiblitaets-Wrapper +;; Laedt vf_core.lsp (Plugin-Dispatcher-Architektur) ;; ============================================================ - -(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) - ) +(if (getenv "DXFM_LISP") + (load (strcat (getenv "DXFM_LISP") "/vf_core.lsp")) + (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.") ) - -;; Pfad zu den Einzelblock-DXF-Dateien (zeigt auf 2D oder 3D Unterverzeichnis) -(setq block-pfad modul-pfad) - -;; Kern-Abhaengigkeiten sicherstellen (fuer direktes Laden ohne Menu-System) -(if (not *ssg-core-loaded*) - (if (getenv "DXFM_LISP") - (progn - (load (strcat (getenv "DXFM_LISP") "/ssg_core.lsp")) - (ssg-load-config) - (setq *ssg-core-loaded* t) - ) - (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.") - ) -) - -(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) ;; Standardwert; wird in c:VarioFoerderer via ssg-cfg-or ueberschrieben -(setq FESTE_HORIZONTAL 1600) - -;; Block-Zaehler (persistiert ueber mehrere Aufrufe) -(if (null #VF_LetzteNr) (setq #VF_LetzteNr 0)) - -;; Attribut-Definitionen fuer VF-Block (TAG Standardwert) -(setq *vf-attrib-defs* - '(("NUMMER" "0") - ("MONTAGEHOEHE" "0.000") - ("HOEHE_VON" "0") - ("HOEHE_BIS" "0") - ("DELTA_H" "0") - ("DELTA_L" "0") - ("L_VF_M" "0.000") - ("L_GF_M" "0.000") - ("ANTRIEBFAHRTRICHTUNG" "Auf") - ("WINKEL" "0") - ("ANZAHL_SEPARATOR" "2") - ("ANZAHL_SCANNER" "0"))) - -;; 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) -(setq *ks-cache* nil) ;; KS-Daten Cache: (("blockname" ("KS_EIN" ...) ("KS_AUS" ...)) ...) -(setq *library-loaded* nil) ;; Flag: ils_library.dxf bereits geladen - -;; ============================================================ -;; 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))) -) - -;; KS-Daten relativ zu einem Basispunkt machen (fuer Cache) -(defun ks-relativize (ks-data base-pt) - (mapcar '(lambda (item) - (list (car item) - (mapcar '(lambda (pt) - (list (- (car pt) (car base-pt)) - (- (cadr pt) (cadr base-pt)) - (- (caddr pt) (caddr base-pt)))) - (cadr item)))) - ks-data) -) - -;; Relative KS-Daten auf einen Basispunkt anwenden -(defun ks-absolutize (ks-rel base-pt) - (mapcar '(lambda (item) - (list (car item) - (mapcar '(lambda (pt) - (list (+ (car pt) (car base-pt)) - (+ (cadr pt) (cadr base-pt)) - (+ (caddr pt) (caddr base-pt)))) - (cadr item)))) - ks-rel) -) - -;; ============================================================ -;; TEIL 4: KS_EIN/KS_AUS EXTRAKTION (KERN-FUNKTION) -;; ============================================================ - -;; Grad-Zeichen fuer Blocknamen -(setq grad-zeichen (chr 176)) - -;; Laedt Bloecke aus ils_library.dxf (einmalig, laedt alle Bloecke auf einmal). -;; Fallback: Einzeldatei block-pfad/.dxf -(defun ensure-block-loaded (blockname / lib-datei block-datei temp-obj) - (if (not (tblsearch "BLOCK" blockname)) - (progn - ;; Bibliothek laden (enthaelt alle Bloecke). - ;; *library-loaded* immer zuruecksetzen wenn ein Block fehlt: - ;; - nach Zeichnungswechsel fehlen alle Bloecke - ;; - oder die Bibliothek wurde von einem anderen Befehl geladen - ;; aber der angeforderte Block war nicht enthalten - (if *library-loaded* - (setq *library-loaded* nil) - ) - (if (not *library-loaded*) - (progn - (setq lib-datei - (strcat (vl-string-translate "\\" "/" (getenv "DXFM_DATA")) - "/block_libraries/ils_library.dxf")) - (if (findfile lib-datei) - (progn - (princ "\n Lade ils_library.dxf ...") - (setq temp-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - lib-datei 1.0 1.0 1.0 0)) - (vla-Delete temp-obj) - (setq *library-loaded* T) - (princ " OK") - ) - (princ (strcat "\n WARNUNG: Bibliothek nicht gefunden: " lib-datei)) - ) - ) - ) - ;; Fallback: Einzeldatei (fuer Bloecke ausserhalb der Bibliothek) - (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: Block nicht gefunden: " blockname)) - ) - ) - ) - ) - ) -) - -;; 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) - (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)) - ) - - ks-results -) - -;; Gecachte Version: prueft *ks-cache* anhand Blockname -;; Beim ersten Aufruf wird explodiert und das Ergebnis relativ -;; 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") - (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)) - (ks-absolutize (cdr cached) insert-pt) - ) - (progn - ;; (dbg (strcat " KS-Cache MISS: " blockname)) - (setq result (extract-ks-from-block-raw block-obj)) - (if result - (progn - (setq ks-rel (ks-relativize result insert-pt)) - (setq *ks-cache* (cons (cons blockname ks-rel) *ks-cache*)) - ) - ) - result - ) - ) -) - -;; ============================================================ -;; 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) - ) - ) - pt -) - -;; ============================================================ -;; TEIL 5: 3D-LINIE AUSWÄHLEN (für Start- und Endpunkt mit Höhe) -;; ============================================================ -(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)) - (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: HILFSFUNKTIONEN BLOCK-VERWALTUNG -;; ============================================================ - -;; Naechste freie VF-Nummer ermitteln (sucht in vorhandenen VF_*-Bloecken) -(defun vf-next-number ( / ss i nr maxnr attribs) - (setq maxnr 0) - (setq ss (ssget "X" '((0 . "INSERT") (2 . "VF_*")))) - (if ss - (progn - (setq i 0) - (while (< i (sslength ss)) - (setq attribs (ssg-attrib-read (ssname ss i))) - (foreach pair attribs - (if (= (car pair) "NUMMER") - (progn - (setq nr (atoi (cdr pair))) - (if (> nr maxnr) (setq maxnr nr)) - ) - ) - ) - (setq i (1+ i)) - ) - ) - ) - (setq #VF_LetzteNr (max #VF_LetzteNr maxnr)) - (setq #VF_LetzteNr (1+ #VF_LetzteNr)) - #VF_LetzteNr -) - -;; ============================================================ -;; TEIL 7: BIBLIOTHEK LADEN & MAßE EXTRAHIEREN -;; ============================================================ - -;; 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.") - t - ) - (progn - (setq *ks-cache* nil) - (princ "\n Initialisiere Bibliothek...") - - ;; === AUS_ELEMENT / EIN_ELEMENT – beide Seiten vorladen === - (ensure-block-loaded "_3D_AS_90_rechts") - (ensure-block-loaded "_3D_ES_90_rechts") - - ;; === AUS_ELEMENT Masse extrahieren (links als Referenz) === - (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)) - "_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 (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq aus-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) - (setq aus-dz (- (caddr (car ks-aus-pos)) (caddr (car 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 geladen!") - ) - - ;; === 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 ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq ein-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) - (setq ein-dz (- (caddr (car ks-aus-pos)) (caddr (car 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 geladen!") - ) - - ;; === Bogen-Masse extrahieren - ALLE Winkel === - (princ "\n Extrahiere Bogen-Masse...") - (setq bogen-auf '()) - (setq bogen-ab '()) - (setq bogen-winkel (ssg-cfg-or "vario" "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 (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) - (setq dz (- (caddr (car ks-aus-pos)) (caddr (car 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 (- (caar ks-aus-pos) (caar ks-ein-pos))) - (setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) - (setq dz (- (caddr (car ks-aus-pos)) (caddr (car 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") - (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!")) - ) - result -) - -;; ============================================================ -;; TEIL 7: BLOCK EINFÜGEN MIT KS_EIN AUSRICHTUNG -;; ============================================================ - -;; 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: Ungueltiger Einfuegepunkt fuer '" blockname "'")) - (exit) - ) - ) - - (if (not *lib-initialized*) (init-bibliothek)) - (ensure-block-loaded blockname) - - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - Einfuegen abgebrochen")) - (exit) - ) - ) - - (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)) - - (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 - (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)) - - (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))) - ausgang - ) - (progn - (princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!") - 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 - (ensure-block-loaded blockname) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - Einfuegen abgebrochen")) - (exit) - ) - ) - (princ (strcat "\n Fuege '" blockname "' ein (Laenge=" (rtos laenge 2 2) " mm, Winkel=" (itoa winkel) "°)")) - - (setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0))) - (setq rad (* winkel (/ pi 180.0))) - - ;; Block am Ursprung einfuegen, damit TransformBy um (0,0,0) rotiert (= Block-Einfuegepunkt) - (setq block-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - blockname scale 1.0 1.0 0)) - - ;; 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) - (list (- (sin rad)) 0 (cos rad) 0) - (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))) - (cadr startpunkt) - (+ (caddr startpunkt) (* (- (sin rad)) laenge)))) - - (princ (strcat "\n Endpunkt: Z=" (rtos (caddr endpunkt) 2 2))) - endpunkt - ) - ) -) - -;; 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 Einfuegepunkt fuer '" blockname "'")) - startpunkt - ) - (progn - (ensure-block-loaded blockname) - (if (not (tblsearch "BLOCK" blockname)) - (progn - (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - Einfuegen abgebrochen")) - (exit) - ) - ) - (princ (strcat "\n Fuege Block '" blockname "' ein (Rotation " (itoa winkel) "°)")) - - (setq rad (* winkel (/ pi 180.0))) - - ;; Block am Ursprung einfuegen, damit TransformBy korrekt um (0,0,0) rotiert - (setq block-obj (vla-InsertBlock modelspace - (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) - (list 0 1 0 0) - (list (- (sin rad)) 0 (cos rad) 0) - (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: 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 - ) - ) -) -;; ============================================================ -;; 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α - winkel-eff cosEff sinEff rad5 rad7 - winkel mass1 mass2 gueltig - best-winkel best-L_GF best-L_VF) - ;; (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 (ssg-cfg-or "vario" "bogen_winkel" '(3 6 9 12 15 18 21 27 33 39 45 51))) - - (setq ergebnis-liste '()) - (setq cos3 (cos (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))) - sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 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 - ;; Schritt 5: Bogen bei Rotation=3° ("Auf"→bogen-auf, "Ab"→bogen-ab) - ;; Schritt 7: Bogen bei Rotation=(3-winkel)° ("Auf"→bogen-ab, "Ab"→bogen-auf) - (if (= richtung "Auf") - (progn - (setq mass1 (get-bogen-mass bogen-auf winkel)) - (setq mass2 (get-bogen-mass bogen-ab winkel)) - ) - (progn - (setq mass1 (get-bogen-mass bogen-ab winkel)) - (setq mass2 (get-bogen-mass bogen-auf 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 (or (null mass1) (null mass2)) - (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) ")")) - - ;; Rotierte Bogen-Vorschübe (exakte Geometrie gemaess insert-rotated-block-with-ks): - ;; Δx = dx*cos(rad) + dz*sin(rad) - ;; Δz = -dx*sin(rad) + dz*cos(rad) - ;; Schritt 5: Rotation = 3° - ;; Schritt 7: Rotation = (3 - winkel)° - (setq rad5 (* 3.0 (/ pi 180.0))) - (setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3))) (/ pi 180.0))) - - (setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5)))) - (setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5)))) - (setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7)))) - (setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7)))) - - (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))) - - ;; Effektiver L_VF-Winkel: "Auf" → alpha-3, "Ab" → alpha+3 - (setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3))) - (setq cosEff (cos (* winkel-eff (/ pi 180.0)))) - (setq sinEff (sin (* winkel-eff (/ pi 180.0)))) - - ;; B-Berechnung: - ;; "Auf": L_VF geht RAUF → B = deltaH + |dz_AUS| + |dz_EIN| - b5z - b7z + FESTE*sin3 - ;; "Ab": L_VF geht RUNTER → B = deltaH - |dz_AUS| - |dz_EIN| - FESTE*sin3 + b5z + b7z - (if (= richtung "Auf") - (setq B (+ deltaH abs-dz-AUS abs-dz-EIN (- bogen-z1) (- bogen-z2) (* FESTE_HORIZONTAL sin3))) - (setq B (+ (- deltaH abs-dz-AUS abs-dz-EIN (* FESTE_HORIZONTAL sin3)) bogen-z1 bogen-z2)) - ) - - ;; Gleichungssystem (L_GF = Gesamtlaenge beider GF-Strecken): - ;; L_GF*cos3 + L_VF*cosEff = A - ;; ±L_GF*sin3 + L_VF*sinEff = B - ;; Loesung: - ;; L_GF = (A*sinEff - B*cosEff) / sinα - ;; L_VF = (A*sin3 +/- B*cos3) / sinα - (if (> (abs sinα) 0.0001) - (progn - (setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα)) - (if (= richtung "Auf") - (setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα)) - (setq L_VF (/ (- (* B cos3) (* A sin3)) sinα)) - ) - (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!")) - - (list best-winkel best-L_GF best-L_VF ergebnis-liste) -) - -;; ============================================================ -;; TEIL 9: BESCHRIFTUNG & MODULE EINFÜGEN -;; ============================================================ - -;; Erzeugt die sichtbare Beschriftungszeile oberhalb der Foerderanlage. -;; Platzierung: horizontal zentriert ueber der Anlage, Y-Offset nach oben. -(defun vf-make-label (vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF - richtung best-winkel n-separator n-scanner startpunkt / - label-txt label-pt L_VF_str L_GF_str delta-sym) - (setq delta-sym (chr 916)) ;; Delta-Zeichen (Unicode) - (setq L_VF_str (vl-string-subst "," "." (rtos (/ L_VF 1000.0) 2 3))) - (setq L_GF_str (vl-string-subst "," "." (rtos (/ L_GF 1000.0) 2 3))) - (setq label-txt - (strcat "VF" (itoa vf-nummer) - ": von " (itoa (fix hoehe-von)) "mm bis " (itoa (fix hoehe-bis)) "mm, " - delta-sym "H=" (itoa (fix deltaH)) "mm; " - delta-sym "L=" (itoa (fix deltaL)) "mm; " - "VF:" L_VF_str "m; " - "GF:" L_GF_str "m; " - richtung ": " (itoa best-winkel) grad-zeichen "; " - "Sep: " (itoa n-separator) "; " - "Scan: " (itoa n-scanner))) - ;; Position: Mitte entlang X, 1500mm ueber Startpunkt in Y - (setq label-pt (list - (+ (car startpunkt) (/ deltaL 2.0)) - (- (cadr startpunkt) 200.0) - (caddr startpunkt))) - (entmake (list - '(0 . "TEXT") - (cons 8 "VF_Beschriftung") - '(67 . 0) ;; Modellbereich - (cons 10 label-pt) - (cons 40 100.0) - (cons 1 label-txt) - (cons 50 0.0) - '(72 . 1) ;; horizontal zentriert - '(73 . 2) ;; vertikal mittig - (cons 11 label-pt) - )) -) - -(defun variofoerderer-einfuegen (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite vf-nummer n-scanner - / aktueller-punkt bogen-name endpunkt bogen-mass bogen-dx bogen-dz - as-block es-block - lastEnt vf-ss vf-e vf-bname vf-insert - hoehe-von hoehe-bis montagehoehe-m L_GF attdef-ypos) - (setq aktueller-punkt startpunkt) - (setq as-block (strcat "_3D_AS_90_" seite)) - (setq es-block (strcat "_3D_ES_90_" seite)) - - (if (not *lib-initialized*) (init-bibliothek)) - - ;; Letzte bestehende Entity merken (fuer spaetere Block-Erstellung) - (setq lastEnt (entlast)) - (if (and lastEnt - (= (cdr (assoc 0 (entget lastEnt))) "INSERT") - (= (cdr (assoc 66 (entget lastEnt))) 1)) - (progn - (setq lastEnt (entnext lastEnt)) - (while (and lastEnt (/= (cdr (assoc 0 (entget lastEnt))) "SEQEND")) - (setq lastEnt (entnext lastEnt)) - ) - ) - ) - - ;; Hoehenangaben fuer Attribute und Beschriftung - (setq hoehe-von (caddr startpunkt)) - (setq hoehe-bis (cond - ((= richtung "Auf") (+ hoehe-von deltaH)) - ((= richtung "Ab") (- hoehe-von deltaH)) - (t hoehe-von))) - - ;; 1. AUS_Element - (princ (strcat "\n\n1/11: " as-block " (0°)")) - (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt)) - - ;; 2. 1. Gefällestrecke - (if (> L_GF1 0.1) - (progn - (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 (ssg-cfg-or "vario" "gefaelle_winkel" 3))) - ) - (princ "\n\n2/11: (uebersprungen)") - ) - - ;; 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 - (ssg-cfg-or "vario" "gefaelle_winkel" 3) - (ssg-cfg-or "vario" "separator_block_dx" 300) - (ssg-cfg-or "vario" "separator_block_dz" 0))) - - ;; 4. Umlenkstation – Rotation um 3° um Y-Achse - (princ "\n\n4/11: Umlenkstation (500mm, 3° geneigt)") - (setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt (ssg-cfg-or "vario" "gefaelle_winkel" 3) - (ssg-cfg-or "vario" "station_block_dx" 500) - (ssg-cfg-or "vario" "station_block_dz" 0))) - - ;; 5. 1. Vertikalbogen - (if (= richtung "Auf") - (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 (ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz)) - - ;; 6. Variable Strecke L_VF - (if (> L_VF 0.1) - (progn - (if (= richtung "Auf") - (progn - (princ (strcat "\n\n6/11: Steigungsstrecke (" (itoa (- (- best-winkel 3))) "°, Laenge=" (rtos L_VF 2 2) " mm)")) - (setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_VF (- (- best-winkel 3)))) - ) - (progn - (princ (strcat "\n\n6/11: Gefaellestrecke (" (itoa (+ best-winkel 3)) "°, Laenge=" (rtos L_VF 2 2) " mm)")) - (setq aktueller-punkt (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_VF (+ best-winkel 3))) - ) - ) - ) - (princ "\n\n6/11: (uebersprungen)") - ) - - ;; 7. 2. Vertikalbogen - (if (= richtung "Auf") - (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)) - ) - ) - (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass)) - (if (= richtung "Auf") - (progn - (princ (strcat "\n\n7/11: " bogen-name " (" (itoa (- 3 best-winkel)) "° geneigt)")) - (setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt (- 3 best-winkel) bogen-dx bogen-dz)) - ) - (progn - (princ (strcat "\n\n7/11: " bogen-name " (" (itoa (+ best-winkel 3)) "° geneigt)")) - (setq aktueller-punkt (insert-rotated-block-with-ks bogen-name aktueller-punkt (+ best-winkel 3) bogen-dx bogen-dz)) - ) - ) - - ;; 8. Motorstation – Rotation um 3° um Y-Achse - (princ "\n\n8/11: Motorstation (500mm, 3° geneigt)") - (setq aktueller-punkt (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt (ssg-cfg-or "vario" "gefaelle_winkel" 3) - (ssg-cfg-or "vario" "station_block_dx" 500) - (ssg-cfg-or "vario" "station_block_dz" 0))) - - ;; 9. 2. Gefällestrecke - (if (> L_GF2 0.1) - (progn - (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 (ssg-cfg-or "vario" "gefaelle_winkel" 3))) - ) - (princ "\n\n9/11: (uebersprungen)") - ) - - ;; 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 - (ssg-cfg-or "vario" "gefaelle_winkel" 3) - (ssg-cfg-or "vario" "separator_block_dx" 300) - (ssg-cfg-or "vario" "separator_block_dz" 0))) - - ;; 11. EIN_Element - (princ (strcat "\n\n11/11: " es-block " (0°)")) - (setq endpunkt (insert-block-by-ks es-block aktueller-punkt)) - - (princ "\n\n=========================================") - (princ "\n>>> VarioFoerderer erfolgreich eingefuegt!") - - ;; ====== BLOCK ERSTELLEN ====== - (setq L_GF (+ L_GF1 L_GF2)) - - ;; Beschriftungstext erzeugen (wird Teil des Blocks) - (vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF - richtung best-winkel 2 n-scanner startpunkt) - - ;; Unsichtbare ATTDEFs am Startpunkt erzeugen (werden Teil des Blocks) - (setq attdef-ypos (cadr startpunkt)) - (foreach def *vf-attrib-defs* - (entmake (list - '(0 . "ATTDEF") - '(8 . "0") - '(67 . 0) ;; Modellbereich - (cons 10 (list (car startpunkt) attdef-ypos (caddr startpunkt))) - '(40 . 50.0) - (cons 1 (cadr def)) - (cons 3 (car def)) - (cons 2 (car def)) - '(70 . 1) ;; unsichtbar - )) - (setq attdef-ypos (- attdef-ypos 100.0)) - ) - - ;; Alle neuen Entities (seit lastEnt) in Selektionssatz sammeln - (setq vf-ss (ssadd)) - (if lastEnt - (setq vf-e (entnext lastEnt)) - (setq vf-e (entnext)) - ) - (while vf-e - (ssadd vf-e vf-ss) - (setq vf-e (entnext vf-e)) - ) - - (setq vf-bname (strcat "VF_" (itoa vf-nummer))) - (if (> (sslength vf-ss) 0) - (progn - (setvar "ATTREQ" 0) - (setvar "ATTDIA" 0) - (command "_.-BLOCK" vf-bname startpunkt vf-ss "") - (command "_.INSERT" vf-bname startpunkt 1.0 1.0 0.0) - (setvar "ATTREQ" 1) - ;; Attributwerte auf den eingefuegten Block setzen - (setq vf-insert (entlast)) - (setq montagehoehe-m (/ (+ hoehe-von hoehe-bis) 2000.0)) - (ssg-attrib-set-on vf-insert - (list - (cons "NUMMER" (itoa vf-nummer)) - (cons "MONTAGEHOEHE" (rtos montagehoehe-m 2 3)) - (cons "HOEHE_VON" (itoa (fix hoehe-von))) - (cons "HOEHE_BIS" (itoa (fix hoehe-bis))) - (cons "DELTA_H" (itoa (fix deltaH))) - (cons "DELTA_L" (itoa (fix deltaL))) - (cons "L_VF_M" (rtos (/ L_VF 1000.0) 2 3)) - (cons "L_GF_M" (rtos (/ L_GF 1000.0) 2 3)) - (cons "ANTRIEBFAHRTRICHTUNG" richtung) - (cons "WINKEL" (itoa best-winkel)) - (cons "ANZAHL_SEPARATOR" "2") - (cons "ANZAHL_SCANNER" (itoa n-scanner)) - ) - ) - (princ (strcat "\n>>> Block '" vf-bname "' erstellt und eingefuegt.")) - ) - (princ "\n>>> FEHLER: Keine Entities fuer Block gefunden!") - ) - (princ "\n=========================================") - nil -) -;; ============================================================ -;; TEIL 10: HAUPTFUNKTION -;; ============================================================ -(defun c:VarioFoerderer ( / 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 - gueltige-winkel idx eintrag wahl - seite vf-nummer n-scanner) - ;; (dbgf "c:FOERDERANLAGE") - - (princ "\n=========================================") - (princ "\n VARIOFOERDERER 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) - ) - ) - - ;; Konfigurationswerte laden (ssg-core muss bereits geladen sein) - (setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000)) - (setq FESTE_HORIZONTAL (ssg-cfg-or "vario" "feste_horizontal" 1600)) - - ;; VF-Nummer automatisch ermitteln - (setq vf-nummer (vf-next-number)) - (princ (strcat "\n>>> Naechste VF-Nummer: VF" (itoa vf-nummer))) - - (princ "\n\nEingabemodus wählen:") - (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 "Linie")) - ((= antwort "2") (setq eingabe-modus "Wert")) - (t (setq eingabe-modus "Linie") (princ "\nUngültige Eingabe, Modus '3D-Linie auswählen'")) - ) - - (if (= eingabe-modus "Linie") - (progn - (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!") - - - (setq line-points - (get-line-start-end-points - "\nBitte 3D-Linie (oder Polylinie) für die Förderstrecke auswählen:")) - - (if (null line-points) - (progn (alert "Keine gültige Linie ausgewählt!") (exit)) - ) - - (setq startpunkt (car line-points)) - (setq endpunkt (cadr line-points)) - - (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))) - (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 (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) - (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 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" - "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>>> 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=========================================") - - ;; Seite: links oder rechts - (princ "\n\nEin-/Auselement - Seite waehlen:") - (princ "\n 1 - Links (_3D_AS_90_links / _3D_ES_90_links)") - (princ "\n 2 - Rechts (_3D_AS_90_rechts / _3D_ES_90_rechts)") - (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) - (if (= antwort "2") - (setq seite "rechts") - (setq seite "links") - ) - (princ (strcat "\n>>> Seite: " seite)) - - ;; 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")) - - ;; Anzahl Scanner abfragen - (setq n-scanner (getint "\nAnzahl Scanner [0]: ")) - (if (null n-scanner) (setq n-scanner 0)) - - (princ "\n\nMoechten Sie die Foerderanlage einfuegen?\n 1 - Ja, Module einfuegen\n 2 - Nein, abbrechen") - (setq antwort (getstring "\nIhre Wahl (1/2): ")) - - (if (= antwort "1") - (variofoerderer-einfuegen deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt-fuer-einfuegen seite vf-nummer n-scanner) - (princ "\nVorgang abgebrochen.") - ) - - nil -) -;; ============================================================ -;; START -;; ============================================================ -;; Rueckwaertskompatibilitaet -(defun c:FOERDERANLAGE () (c:VarioFoerderer)) - -(princ "\n=========================================") -(princ "\n>>> VarioFoerderer Generator v25.0 geladen <<<") -(princ "\n>>> Befehle: VarioFoerderer (Alias: FOERDERANLAGE) <<<") -(princ "\n>>> 100% bibliotheksbasiert - KEINE Fallbacks <<<") -(princ "\n=========================================") -(princ) \ No newline at end of file diff --git a/Lisp/vf_core.lsp b/Lisp/vf_core.lsp new file mode 100644 index 0000000..fe767de --- /dev/null +++ b/Lisp/vf_core.lsp @@ -0,0 +1,894 @@ +;; ============================================================ +;; VF_CORE - VarioFoerderer Kern-Modul +;; Version: 26.0 +;; Architektur: Plugin/Dispatcher +;; Laedt automatisch: vf_standard.lsp, vf_etage.lsp +;; Befehle: VarioFoerderer (Alias: FOERDERANLAGE, ETAGEVARIOFOERDERER) +;; ============================================================ + +(vl-load-com) + +;; ============================================================ +;; TEIL 1: ABHAENGIGKEITEN +;; ============================================================ +(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) + ) +) + +(setq block-pfad modul-pfad) + +(if (not *ssg-core-loaded*) + (if (getenv "DXFM_LISP") + (progn + (load (strcat (getenv "DXFM_LISP") "/ssg_core.lsp")) + (ssg-load-config) + (setq *ssg-core-loaded* t) + ) + (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.") + ) +) + +(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) +(setq modelspace (vla-get-ModelSpace doc)) + +;; ============================================================ +;; TEIL 2: TYP-REGISTRY +;; ============================================================ +(if (null *vf-typ-registry*) (setq *vf-typ-registry* nil)) +(if (null *vf-vorauswahl-typ*) (setq *vf-vorauswahl-typ* nil)) + +;; Registriert einen Foerderanlagen-Typ. +;; berechne-fn: '(lambda (deltaL deltaH richtung seite) ...) +;; Ruft init-Bibliothek und Winkelberechnung auf. +;; Gibt zurueck: (list best-winkel best-L_GF best-L_VF ergebnis-liste) +;; einfuege-fn: '(lambda (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite) ...) +;; Fuegt alle Bloecke ein. Gibt endpunkt zurueck. +(defun vf-typ-registrieren (typ-name berechne-fn einfuege-fn beschreibung) + (if (assoc typ-name *vf-typ-registry*) + (princ (strcat "\n Typ '" typ-name "' bereits registriert.")) + (setq *vf-typ-registry* + (append *vf-typ-registry* + (list (list typ-name berechne-fn einfuege-fn beschreibung)))) + ) +) + +;; ============================================================ +;; TEIL 3: GLOBALE VARIABLEN +;; ============================================================ +(if (null #VF_LetzteNr) (setq #VF_LetzteNr 0)) +(setq *library-loaded* nil) +(setq *ks-cache* nil) +(setq grad-zeichen (chr 176)) + +;; 26 Attribut-Definitionen fuer VF_*-Block (alle Typen) +(setq *vf-attrib-defs* + '(("NUMMER" "0") + ("MONTAGEHOEHE_m" "0.000") + ("HOEHE_VON" "0") + ("HOEHE_BIS" "0") + ("DELTA_H" "0") + ("DELTA_L" "0") + ("L_VF_m" "0.000") + ("L_GF_m" "0.000") + ("ANTRIEBFAHRTRICHTUNG" "Auf") + ("WINKEL" "0") + ("ANZAHL_SEPARATOR" "2") + ("ANZAHL_SCANNER" "0") + ("TYP" "standard") + ("SEITE" "rechts") + ("GF_Bogen_L_90" "0") + ("GF_Bogen_L_60" "0") + ("GF_Bogen_L_30" "0") + ("GF_Bogen_R_90" "0") + ("GF_Bogen_R_60" "0") + ("GF_Bogen_R_30" "0") + ("VF_Bogen_A_90" "0") + ("VF_Bogen_A_60" "0") + ("VF_Bogen_A_30" "0") + ("VF_Bogen_I_90" "0") + ("VF_Bogen_I_60" "0") + ("VF_Bogen_I_30" "0"))) + +;; ============================================================ +;; TEIL 4: 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") + ((and (> len 99) (< len 101)) "X") + ((and (> len 1.5) (< len 2.5)) "Y") + ((and (> len 2.5) (< len 3.5)) "Z") + (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)))) + +(defun ks-relativize (ks-data base-pt) + (mapcar '(lambda (item) + (list (car item) + (mapcar '(lambda (pt) + (list (- (car pt) (car base-pt)) + (- (cadr pt) (cadr base-pt)) + (- (caddr pt) (caddr base-pt)))) + (cadr item)))) + ks-data)) + +(defun ks-absolutize (ks-rel base-pt) + (mapcar '(lambda (item) + (list (car item) + (mapcar '(lambda (pt) + (list (+ (car pt) (car base-pt)) + (+ (cadr pt) (cadr base-pt)) + (+ (caddr pt) (caddr base-pt)))) + (cadr item)))) + ks-rel)) + +;; ============================================================ +;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION +;; ============================================================ +(defun ensure-block-loaded (blockname / lib-datei block-datei temp-obj) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (if *library-loaded* (setq *library-loaded* nil)) + (if (not *library-loaded*) + (progn + (setq lib-datei + (strcat (vl-string-translate "\\" "/" (getenv "DXFM_DATA")) + "/block_libraries/ils_library.dxf")) + (if (findfile lib-datei) + (progn + (princ "\n Lade ils_library.dxf ...") + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + lib-datei 1.0 1.0 1.0 0)) + (vla-Delete temp-obj) + (setq *library-loaded* T) + (princ " OK") + ) + (princ (strcat "\n WARNUNG: Bibliothek nicht gefunden: " lib-datei)) + ) + ) + ) + (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: Block nicht gefunden: " blockname)) + ) + ) + ) + ) + ) +) + +(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) + (setq ks-results '()) + (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)) + (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)) + ) + (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)) + ) + ) + ) + ) + (foreach sub-obj sub-entities + (if (not (vlax-erased-p sub-obj)) (vla-Delete sub-obj)) + ) + ks-results +) + +(defun extract-ks-from-block (block-obj / blockname insert-pt cached result ks-rel) + (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 + (ks-absolutize (cdr cached) insert-pt) + (progn + (setq result (extract-ks-from-block-raw block-obj)) + (if result + (progn + (setq ks-rel (ks-relativize result insert-pt)) + (setq *ks-cache* (cons (cons blockname ks-rel) *ks-cache*)) + ) + ) + result + ) + ) +) + +;; ============================================================ +;; TEIL 6: PUNKTE-AUSWAHL +;; ============================================================ +(defun get-3d-point-from-object (msg / ent obj pt variant) + (princ msg) + (princ "\n >> Objekt (Block) waehlen: ") + (setq ent (entsel)) + (if ent + (progn + (setq obj (vlax-ename->vla-object (car ent))) + (if (vlax-property-available-p obj 'InsertionPoint) + (progn + (setq variant (vla-get-InsertionPoint obj)) + (setq pt (vlax-safearray->list (vlax-variant-value variant))) + (princ (strcat "\n Block-Einfuegepunkt: X=" (rtos (car pt) 2 3) + " Y=" (rtos (cadr pt) 2 3) " Z=" (rtos (caddr pt) 2 3))) + ) + (progn + (setq pt (cadr ent)) + (princ (strcat "\n Punkt auf Objekt: Z=" (rtos (caddr pt) 2 2) " mm")) + ) + ) + ) + (progn + (princ "\n Kein Objekt gewaehlt.") + (setq pt nil) + ) + ) + pt +) + +(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt) + (princ msg) + (princ "\n >> 3D-Linie oder Polylinie waehlen: ") + (setq ent (entsel)) + (if ent + (progn + (setq obj (vlax-ename->vla-object (car ent))) + (setq obj-name (vla-get-ObjectName obj)) + (cond + ((= 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:" + "\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))) + ) + ((= obj-name "AcDbPolyline") + (setq start-pt (vlax-curve-getStartPoint obj)) + (setq end-pt (vlax-curve-getEndPoint obj)) + (princ (strcat "\n 3D-Polylinie:" + "\n Start Z=" (rtos (caddr start-pt) 2 2) + " Ende Z=" (rtos (caddr end-pt) 2 2))) + ) + (t + (princ "\n FEHLER: Keine Linie oder Polylinie ausgewaehlt!") + (setq start-pt nil end-pt nil) + ) + ) + ) + (progn + (princ "\n Kein Objekt gewaehlt.") + (setq start-pt nil end-pt nil) + ) + ) + (if (and start-pt end-pt) (list start-pt end-pt) nil) +) + +;; ============================================================ +;; TEIL 7: VF-NUMMERIERUNG +;; ============================================================ +(defun vf-next-number ( / ss i nr maxnr attribs) + (setq maxnr 0) + (setq ss (ssget "X" '((0 . "INSERT") (2 . "VF_*")))) + (if ss + (progn + (setq i 0) + (while (< i (sslength ss)) + (setq attribs (ssg-attrib-read (ssname ss i))) + (foreach pair attribs + (if (= (car pair) "NUMMER") + (progn + (setq nr (atoi (cdr pair))) + (if (> nr maxnr) (setq maxnr nr)) + ) + ) + ) + (setq i (1+ i)) + ) + ) + ) + (setq #VF_LetzteNr (max #VF_LetzteNr maxnr)) + (setq #VF_LetzteNr (1+ #VF_LetzteNr)) + #VF_LetzteNr +) + +;; ============================================================ +;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen) +;; ============================================================ +(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: Ungueltiger Einfuegepunkt fuer '" blockname "'")) + (exit) + ) + ) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) + (exit) + ) + ) + (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)) + (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 + (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)) + (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))) + ausgang + ) + (progn + (princ "\n WARNUNG: KS_EIN/KS_AUS nicht gefunden!") + einfuegepunkt + ) + ) +) + +(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) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) + (exit) + ) + ) + (princ (strcat "\n Fuege '" blockname "' ein" + " (L=" (rtos laenge 2 2) " mm, W=" (itoa winkel) (chr 176) ")")) + (setq scale (/ laenge (ssg-cfg-or "vario" "skalierung_basis" 1000.0))) + (setq rad (* winkel (/ pi 180.0))) + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname scale 1.0 1.0 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-obj (vlax-tmatrix matrix)) + (vla-Move block-obj + (vlax-3D-point '(0 0 0)) + (vlax-3D-point startpunkt)) + (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 + ) + ) +) + +(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: Ungueltiger Einfuegepunkt fuer '" blockname "'")) + startpunkt + ) + (progn + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) + (exit) + ) + ) + (princ (strcat "\n Fuege Block '" blockname "' ein" + " (Rotation " (itoa winkel) (chr 176) ")")) + (setq rad (* winkel (/ pi 180.0))) + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 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-obj (vlax-tmatrix matrix)) + (vla-Move block-obj + (vlax-3D-point '(0 0 0)) + (vlax-3D-point startpunkt)) + (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 + ) + ) +) + +;; ============================================================ +;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE +;; ============================================================ +(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz + deltaL deltaH deltaX deltaY richtung antwort) + (princ "\n\nEingabemodus waehlen:") + (princ "\n 1 - 3D-Linie auswaehlen (Start- und Endpunkt mit Hoehe)") + (princ "\n 2 - Werte manuell eingeben") + (setq antwort (getstring "\nIhre Wahl (1/2): ")) + (cond + ((= antwort "1") (setq eingabe-modus "Linie")) + ((= antwort "2") (setq eingabe-modus "Wert")) + (t (setq eingabe-modus "Linie") (princ "\nModus: 3D-Linie")) + ) + (if (= eingabe-modus "Linie") + (progn + (princ "\n\n>>> MODUS: 3D-Linie auswaehlen <<<") + (command "BKS" "W") + (princ "\n BKS auf Weltkoordinaten gesetzt.") + (setq line-points + (get-line-start-end-points "\nBitte 3D-Linie fuer die Foerderstrecke auswaehlen:")) + (if (null line-points) + (progn (alert "Keine gueltige Linie ausgewaehlt!") (exit)) + ) + (setq startpunkt (car line-points) + endpunkt (cadr line-points)) + (setq differenz (punkt-differenz startpunkt endpunkt)) + (setq deltaX (abs (car differenz)) + deltaY (abs (cadr differenz)) + deltaH (caddr differenz)) + (setq deltaL (max deltaX deltaY)) + (princ (strcat "\n △L=" (rtos deltaL 2 2) " mm" + " △H=" (rtos deltaH 2 2) " mm")) + (if (>= deltaH 0) + (progn (setq richtung "Auf") (princ "\n Foerderrichtung: AUF")) + (progn (setq richtung "Ab") (setq deltaH (abs deltaH)) + (princ "\n Foerderrichtung: AB")) + ) + ) + (progn + (princ "\n\n>>> MODUS: Manuelle Werteingabe <<<") + (setq deltaL (getreal "\n△L - Horizontale Distanz (mm): ")) + (if (null deltaL) (setq deltaL 15000)) + (setq deltaH (getreal "\n△H - Hoehenunterschied (mm): ")) + (if (null deltaH) (setq deltaH 3000)) + (princ "\nFoerderrichtung:\n 1 - AUF\n 2 - AB") + (setq antwort (getstring "\nIhre Wahl (1/2): ")) + (if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf")) + (setq startpunkt (getpoint "\nStartpunkt fuer AUS_Element waehlen: ")) + (if (null startpunkt) (setq startpunkt '(0 0 0))) + ) + ) + (list deltaL deltaH richtung startpunkt) +) + +;; ============================================================ +;; TEIL 10: VF_*-BLOCK-SYSTEM (gemeinsam fuer alle Typen) +;; ============================================================ +(defun vf-make-label (vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF + richtung best-winkel n-separator n-scanner startpunkt / + label-txt label-pt L_VF_str L_GF_str delta-sym) + (setq delta-sym (chr 916)) + (setq L_VF_str (vl-string-subst "," "." (rtos (/ L_VF 1000.0) 2 3))) + (setq L_GF_str (vl-string-subst "," "." (rtos (/ L_GF 1000.0) 2 3))) + (setq label-txt + (strcat "VF" (itoa vf-nummer) + ": von " (itoa (fix hoehe-von)) "mm bis " (itoa (fix hoehe-bis)) "mm, " + delta-sym "H=" (itoa (fix deltaH)) "mm; " + delta-sym "L=" (itoa (fix deltaL)) "mm; " + "VF:" L_VF_str "m; GF:" L_GF_str "m; " + richtung ": " (itoa best-winkel) grad-zeichen "; " + "Sep: " (itoa n-separator) "; Scan: " (itoa n-scanner))) + (setq label-pt (list + (+ (car startpunkt) (/ deltaL 2.0)) + (- (cadr startpunkt) 200.0) + (caddr startpunkt))) + (entmake (list + '(0 . "TEXT") + (cons 8 "VF_Beschriftung") + '(67 . 0) + (cons 10 label-pt) + (cons 40 100.0) + (cons 1 label-txt) + (cons 50 0.0) + '(72 . 1) + '(73 . 2) + (cons 11 label-pt) + )) +) + +;; Erstellt VF_N-Block aus allen seit lastEnt erzeugten Entities. +;; Setzt Attributwerte entsprechend Typ, Seite und Geometrieparametern. +(defun vf-block-erstellen (anlage-typ seite vf-nummer n-scanner + hoehe-von hoehe-bis deltaH deltaL L_VF L_GF + richtung best-winkel startpunkt lastEnt + / vf-bname vf-ss vf-e vf-insert montagehoehe-m attdef-ypos) + ;; Beschriftungstext erzeugen + (vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF + richtung best-winkel 2 n-scanner startpunkt) + + ;; Unsichtbare ATTDEFs am Startpunkt erzeugen + (setq attdef-ypos (cadr startpunkt)) + (foreach def *vf-attrib-defs* + (entmake (list + '(0 . "ATTDEF") + '(8 . "0") + '(67 . 0) + (cons 10 (list (car startpunkt) attdef-ypos (caddr startpunkt))) + '(40 . 50.0) + (cons 1 (cadr def)) + (cons 3 (car def)) + (cons 2 (car def)) + '(70 . 1) + )) + (setq attdef-ypos (- attdef-ypos 100.0)) + ) + + ;; Alle neuen Entities seit lastEnt sammeln + (setq vf-ss (ssadd)) + (if lastEnt + (setq vf-e (entnext lastEnt)) + (setq vf-e (entnext)) + ) + (while vf-e + (ssadd vf-e vf-ss) + (setq vf-e (entnext vf-e)) + ) + + ;; Block erstellen, einfuegen, Attribute setzen + (setq vf-bname (strcat "VF_" (itoa vf-nummer))) + (if (> (sslength vf-ss) 0) + (progn + (setvar "ATTREQ" 0) + (setvar "ATTDIA" 0) + (command "_.-BLOCK" vf-bname startpunkt vf-ss "") + (command "_.INSERT" vf-bname startpunkt 1.0 1.0 0.0) + (setvar "ATTREQ" 1) + (setq vf-insert (entlast)) + (setq montagehoehe-m (/ (+ hoehe-von hoehe-bis) 2000.0)) + (ssg-attrib-set-on vf-insert + (list + (cons "NUMMER" (itoa vf-nummer)) + (cons "MONTAGEHOEHE_m" (rtos montagehoehe-m 2 3)) + (cons "HOEHE_VON" (itoa (fix hoehe-von))) + (cons "HOEHE_BIS" (itoa (fix hoehe-bis))) + (cons "DELTA_H" (itoa (fix deltaH))) + (cons "DELTA_L" (itoa (fix deltaL))) + (cons "L_VF_m" (rtos (/ L_VF 1000.0) 2 3)) + (cons "L_GF_m" (rtos (/ L_GF 1000.0) 2 3)) + (cons "ANTRIEBFAHRTRICHTUNG" richtung) + (cons "WINKEL" (itoa best-winkel)) + (cons "ANZAHL_SEPARATOR" "2") + (cons "ANZAHL_SCANNER" (itoa n-scanner)) + (cons "TYP" anlage-typ) + (cons "SEITE" seite) + ) + ) + ;; Typ-spezifische Bogen-Zaehler (Etage: 2x Gefaellebogen je Seite) + (if (= anlage-typ "etage") + (if (= seite "rechts") + (ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_R_60" "2"))) + (ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_L_60" "2"))) + ) + ) + (princ (strcat "\n>>> Block '" vf-bname "' erstellt und eingefuegt.")) + ) + (princ "\n>>> FEHLER: Keine Entities fuer Block gefunden!") + ) +) + +;; ============================================================ +;; TEIL 11: UNTERMODULE LADEN +;; ============================================================ +;; Guard: Untermodule nur beim ersten Laden von vf_core.lsp ausfuehren. +(if (not *ssg-vf-submodule-loaded*) + (if (getenv "DXFM_LISP") + (progn + (load (strcat (getenv "DXFM_LISP") "/vf_standard.lsp")) + (load (strcat (getenv "DXFM_LISP") "/vf_etage.lsp")) + (setq *ssg-vf-submodule-loaded* t) + ) + (alert "DXFM_LISP nicht gesetzt - Untermodule konnten nicht geladen werden!") + ) +) + +;; ============================================================ +;; TEIL 12: DISPATCHER c:VarioFoerderer +;; ============================================================ +(defun c:VarioFoerderer ( / typ-eintr anlage-typ berechne-fn einfuege-fn + eingabe deltaL deltaH richtung startpunkt seite + ergebnis ergebnis-liste gueltige-winkel + best-winkel L_GF L_GF1 L_GF2 L_VF + idx eintrag wahl antwort verteilung-modus + n-scanner vf-nummer hoehe-von hoehe-bis lastEnt + staustrecke-basis) + + (princ "\n=========================================") + (princ "\n VARIOFOERDERER GENERATOR v26.0") + (princ "\n=========================================") + + ;; 1. Typ aus Registry waehlen + (if (null *vf-typ-registry*) + (progn + (alert "Keine Typen registriert!\nvf_standard.lsp und vf_etage.lsp pruefen.") + (exit) + ) + ) + + (if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*)) + (progn + (setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*)) + (princ (strcat "\n>>> Typ vorgewaehlt: " *vf-vorauswahl-typ*)) + (setq *vf-vorauswahl-typ* nil) + ) + (progn + (setq *vf-vorauswahl-typ* nil) + (princ "\n\nAnlagen-Typ waehlen:") + (setq idx 1) + (foreach eintr *vf-typ-registry* + (princ (strcat "\n " (itoa idx) " - " (nth 3 eintr))) + (setq idx (1+ idx)) + ) + (setq wahl (getint (strcat "\nIhre Wahl (1-" + (itoa (length *vf-typ-registry*)) ") [1]: "))) + (if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*))) + (setq wahl 1)) + (setq typ-eintr (nth (1- wahl) *vf-typ-registry*)) + ) + ) + (setq anlage-typ (nth 0 typ-eintr)) + (setq berechne-fn (nth 1 typ-eintr)) + (setq einfuege-fn (nth 2 typ-eintr)) + (princ (strcat "\n>>> Typ: " anlage-typ)) + + ;; 2. VF-Nummer automatisch ermitteln + (setq vf-nummer (vf-next-number)) + (princ (strcat "\n>>> Naechste VF-Nummer: VF" (itoa vf-nummer))) + + ;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt) + (setq eingabe (vf-eingabe-abfragen)) + (setq deltaL (nth 0 eingabe) + deltaH (nth 1 eingabe) + richtung (nth 2 eingabe) + startpunkt (nth 3 eingabe)) + + ;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht) + (princ "\n\nSeite waehlen:") + (princ "\n 1 - Rechts") + (princ "\n 2 - Links") + (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) + (if (= antwort "2") (setq seite "links") (setq seite "rechts")) + (princ (strcat "\n>>> Seite: " seite)) + + ;; 5. Typ-spezifische Berechnung (init + berechne) + (setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite))) + (setq ergebnis-liste (cadddr ergebnis)) + + ;; 6. Konfiguration (nach ssg_core-Init verfuegbar) + (setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000)) + + ;; 7. 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" + "△L=" (rtos deltaL 2 0) " mm, △H=" + (rtos deltaH 2 0) " mm, Richtung=" richtung)) + (exit) + ) + ) + + ;; 8. Winkelauswahl (automatisch oder interaktiv) + (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>>> Einziger gueltiger Winkel: " + (itoa best-winkel) (chr 176))) + ) + (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) (chr 176) + " (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>>> Winkel: " (itoa best-winkel) (chr 176) + " L_GF: " (rtos L_GF 2 2) " mm" + " L_VF: " (rtos L_VF 2 2) " mm")) + (princ "\n=========================================") + + ;; 9. L_GF Verteilung + (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 (float staustrecke-basis)) + (setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis))))) + ((= verteilung-modus "3") + (setq L_GF2 (float staustrecke-basis)) + (setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis))))) + ((= 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 (max 0.0 (- L_GF L_GF1))) + (princ (strcat "\n L_GF2 hinten: " (rtos L_GF2 2 2) " mm"))) + (t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0))) + ) + (princ (strcat "\n>>> L_GF1=" (rtos L_GF1 2 2) + " mm L_GF2=" (rtos L_GF2 2 2) " mm")) + + ;; 10. Anzahl Scanner + (setq n-scanner (getint "\nAnzahl Scanner [0]: ")) + (if (null n-scanner) (setq n-scanner 0)) + + ;; 11. Bestaetigung + (princ "\n\nMoechten Sie die Foerderanlage einfuegen?") + (princ "\n 1 - Ja, Module einfuegen\n 2 - Nein, abbrechen") + (setq antwort (getstring "\nIhre Wahl (1/2): ")) + + (if (= antwort "1") + (progn + ;; Hoehenangaben fuer Attribute und Beschriftung + (setq hoehe-von (caddr startpunkt)) + (setq hoehe-bis (cond + ((= richtung "Auf") (+ hoehe-von deltaH)) + ((= richtung "Ab") (- hoehe-von deltaH)) + (t hoehe-von))) + + ;; lastEnt VOR der Einfuegung merken + (setq lastEnt (entlast)) + (if (and lastEnt + (= (cdr (assoc 0 (entget lastEnt))) "INSERT") + (= (cdr (assoc 66 (entget lastEnt))) 1)) + (progn + (setq lastEnt (entnext lastEnt)) + (while (and lastEnt + (/= (cdr (assoc 0 (entget lastEnt))) "SEQEND")) + (setq lastEnt (entnext lastEnt)) + ) + ) + ) + + ;; Typ-spezifische Einfuegung + (apply einfuege-fn + (list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite)) + + ;; Gemeinsame VF_*-Block-Erstellung + (vf-block-erstellen anlage-typ seite vf-nummer n-scanner + hoehe-von hoehe-bis deltaH deltaL L_VF L_GF + richtung best-winkel startpunkt lastEnt) + + (princ "\n=========================================") + ) + (princ "\nVorgang abgebrochen.") + ) + nil +) + +;; ============================================================ +;; START & ALIASES +;; ============================================================ +(defun c:FOERDERANLAGE () (c:VarioFoerderer)) + +(defun c:ETAGEVARIOFOERDERER () + (setq *vf-vorauswahl-typ* "etage") + (c:VarioFoerderer) +) + +;; ssg-ensure-Flags fuer beide Wrapper-Dateien setzen, +;; damit ein zweiter Ladeaufruf uebersprungen wird. +(setq *ssg-VarioFoerderer-loaded* t) +(setq *ssg-EtageVarioFoerderer-loaded* t) + +(princ "\n=========================================") +(princ "\n>>> VF_CORE v26.0 geladen <<<") +(princ "\n=========================================") +(princ "\nBefehle:") +(princ "\n VarioFoerderer - Foerderanlage erstellen (Typ-Auswahl)") +(princ "\n FOERDERANLAGE - Alias fuer VarioFoerderer") +(princ "\n ETAGEVARIOFOERDERER - Etage-Foerderanlage direkt") +(princ "\nRegistrierte Typen:") +(foreach eintr *vf-typ-registry* + (princ (strcat "\n " (car eintr) " - " (nth 3 eintr))) +) +(princ "\n=========================================") +(princ) diff --git a/Lisp/vf_etage.lsp b/Lisp/vf_etage.lsp new file mode 100644 index 0000000..ee319be --- /dev/null +++ b/Lisp/vf_etage.lsp @@ -0,0 +1,784 @@ +;; ============================================================ +;; VF_ETAGE - Etage VarioFoerderer (Typ: "etage") +;; Version: 26.0 +;; Abhaengigkeit: vf_core.lsp muss zuerst geladen sein +;; Geometrie: AS/ES 30 Grad, direkt uebereinander (60 Grad Hz-Winkel) +;; 15-Schritt-Einfuegung +;; ============================================================ + +;; Sicherstellen, dass vf_core.lsp geladen ist +(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN")))) + (if (getenv "DXFM_LISP") + (load (strcat (getenv "DXFM_LISP") "/vf_core.lsp")) + (progn + (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.") + (exit) + ) + ) +) + +;; ============================================================ +;; TEIL 1: ETAGE-SPEZIFISCHE GLOBALE VARIABLEN +;; ============================================================ +(setq etage-aus-dx nil etage-aus-dz nil) +(setq etage-ein-dx nil etage-ein-dz nil) +(setq etage-gef-dx nil etage-gef-dy nil etage-gef-dz nil) +(setq etage-gef-dx-rechts nil etage-gef-dz-rechts nil) +(setq etage-gef-dx-links nil etage-gef-dz-links nil) +(setq *etage-lib-initialized* nil) + +(setq FESTE_ETAGE_MITTE 1000) +(setq ETAGE_SCHRAEG_LAENGE 700) +(setq ETAGE_HZ_WINKEL 60) + +;; ============================================================ +;; TEIL 2: BIBLIOTHEK INITIALISIEREN (ETAGE-SPEZIFISCH) +;; ============================================================ +(defun init-bibliothek-etage ( / temp-obj ks-data ks-ein-pos ks-aus-pos + gefaelle-blockname) + (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts"))) + (setq *etage-lib-initialized* nil)) + (if *etage-lib-initialized* + (progn (princ "\n Etage-Bibliothek bereits initialisiert.") t) + (progn + (princ "\n Initialisiere Etage-Bibliothek...") + + ;; Standard-Bogen-Daten laden (bogen-auf/bogen-ab benoetigt) + (if (not *lib-initialized*) + (init-bibliothek) + ) + + ;; AS_30_rechts Masse extrahieren + (princ "\n Extrahiere AS_30_rechts Masse...") + (ensure-block-loaded "_3D_AS_30_rechts") + (ensure-block-loaded "_3D_AS_30_links") + (if (tblsearch "BLOCK" "_3D_AS_30_rechts") + (progn + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + "_3D_AS_30_rechts" 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 etage-aus-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq etage-aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + (princ (strcat "\n AS_30_rechts: dx=" (rtos etage-aus-dx 2 1) + " mm, dz=" (rtos etage-aus-dz 2 1) " mm")) + ) + (progn + (princ "\n WARNUNG: KS fehlt - Standardwerte") + (setq etage-aus-dx 525.8 etage-aus-dz -72.9) + ) + ) + ) + (progn + (princ "\n WARNUNG: Block _3D_AS_30_rechts fehlt - Standardwerte") + (setq etage-aus-dx 525.8 etage-aus-dz -72.9) + ) + ) + + ;; ES_30_rechts Masse extrahieren + (princ "\n Extrahiere ES_30_rechts Masse...") + (ensure-block-loaded "_3D_ES_30_rechts") + (ensure-block-loaded "_3D_ES_30_links") + (if (tblsearch "BLOCK" "_3D_ES_30_rechts") + (progn + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + "_3D_ES_30_rechts" 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 etage-ein-dx (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq etage-ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + (princ (strcat "\n ES_30_rechts: dx=" (rtos etage-ein-dx 2 1) + " mm, dz=" (rtos etage-ein-dz 2 1) " mm")) + ) + (progn + (princ "\n WARNUNG: KS fehlt - Standardwerte") + (setq etage-ein-dx 576.2 etage-ein-dz -54.6) + ) + ) + ) + (progn + (princ "\n WARNUNG: Block _3D_ES_30_rechts fehlt - Standardwerte") + (setq etage-ein-dx 576.2 etage-ein-dz -54.6) + ) + ) + + ;; Gefaellebogen_links_60 Masse extrahieren + (setq gefaelle-blockname + (strcat "Gefaellebogen_links_60" grad-zeichen "_R500")) + (princ (strcat "\n Extrahiere " gefaelle-blockname " Masse...")) + (ensure-block-loaded gefaelle-blockname) + (if (tblsearch "BLOCK" gefaelle-blockname) + (progn + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) gefaelle-blockname 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 etage-gef-dx-links (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq etage-gef-dz-links (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + ) + (progn + (princ "\n WARNUNG: kein KS - Standardwerte (links)") + (setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0) + ) + ) + ) + (progn + (princ "\n WARNUNG: Block fehlt - Standardwerte (links)") + (setq etage-gef-dx-links 0.0 etage-gef-dz-links -10.0) + ) + ) + (princ (strcat "\n Gefaellebogen links: dx=" (rtos etage-gef-dx-links 2 2) + " dz=" (rtos etage-gef-dz-links 2 2) " mm")) + + ;; Gefaellebogen_rechts_60 Masse extrahieren + (setq gefaelle-blockname + (strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500")) + (princ (strcat "\n Extrahiere " gefaelle-blockname " Masse...")) + (ensure-block-loaded gefaelle-blockname) + (if (tblsearch "BLOCK" gefaelle-blockname) + (progn + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) gefaelle-blockname 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 etage-gef-dx-rechts (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq etage-gef-dz-rechts (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + ) + (progn + (princ "\n WARNUNG: kein KS - Standardwerte (rechts)") + (setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0) + ) + ) + ) + (progn + (princ "\n WARNUNG: Block fehlt - Standardwerte (rechts)") + (setq etage-gef-dx-rechts 0.0 etage-gef-dz-rechts -10.0) + ) + ) + (princ (strcat "\n Gefaellebogen rechts: dx=" (rtos etage-gef-dx-rechts 2 2) + " dz=" (rtos etage-gef-dz-rechts 2 2) " mm")) + + (setq *etage-lib-initialized* t) + (princ "\n Etage-Bibliothek erfolgreich initialisiert.") + t + ) + ) +) + +;; ============================================================ +;; TEIL 3: EINFUEGEFUNKTIONEN MIT KOMBINIERTER HZ+VERT ROTATION +;; ============================================================ +;; Transformationsmatrix: Rz(hz) * Ry(vert) +;; [ cos(hz)*cos(vert) -sin(hz) cos(hz)*sin(vert) ] +;; [ sin(hz)*cos(vert) cos(hz) sin(hz)*sin(vert) ] +;; [ -sin(vert) 0 cos(vert) ] + +(defun insert-hz-incl-scaled-block (blockname startpunkt laenge hz-winkel vert-winkel / + rad-hz rad-vert chz shz cv sv scale + matrix block-obj endpunkt) + (setq scale (/ (float laenge) 1000.0)) + (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) + (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) + (setq chz (cos rad-hz) shz (sin rad-hz)) + (setq cv (cos rad-vert) sv (sin rad-vert)) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) + (exit) + ) + ) + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0)) + (setq matrix (list + (list (* chz cv) (- shz) (* chz sv) 0) + (list (* shz cv) chz (* shz sv) 0) + (list (- sv) 0 cv 0) + (list 0 0 0 1) + )) + (vla-TransformBy block-obj (vlax-tmatrix matrix)) + (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt)) + (setq endpunkt (list + (+ (car startpunkt) (* laenge chz cv)) + (+ (cadr startpunkt) (* laenge shz cv)) + (+ (caddr startpunkt) (* (- sv) laenge)))) + (princ (strcat "\n HzIncl " blockname " L=" (rtos laenge 2 0) + " hz=" (rtos hz-winkel 2 0) (chr 176) + " v=" (rtos vert-winkel 2 0) (chr 176) + " -> Z=" (rtos (caddr endpunkt) 2 1))) + endpunkt +) + +(defun insert-hz-rotated-block-with-ks (blockname startpunkt hz-winkel vert-winkel block-dx block-dz / + rad-hz rad-vert chz shz cv sv + matrix block-obj endpunkt) + (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) + (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) + (setq chz (cos rad-hz) shz (sin rad-hz)) + (setq cv (cos rad-vert) sv (sin rad-vert)) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) + (exit) + ) + ) + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) + (setq matrix (list + (list (* chz cv) (- shz) (* chz sv) 0) + (list (* shz cv) chz (* shz sv) 0) + (list (- sv) 0 cv 0) + (list 0 0 0 1) + )) + (vla-TransformBy block-obj (vlax-tmatrix matrix)) + (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point startpunkt)) + (setq endpunkt (list + (+ (car startpunkt) (+ (* block-dx chz cv) (* block-dz chz sv))) + (+ (cadr startpunkt) (+ (* block-dx shz cv) (* block-dz shz sv))) + (+ (caddr startpunkt) (+ (* (- sv) block-dx) (* cv block-dz))))) + (princ (strcat "\n HzRot " blockname + " hz=" (rtos hz-winkel 2 0) (chr 176) + " v=" (rtos vert-winkel 2 0) (chr 176) + " -> Z=" (rtos (caddr endpunkt) 2 1))) + endpunkt +) + +(defun insert-hz-rotated-block-by-ks (blockname startpunkt hz-winkel vert-winkel / + rad-hz rad-vert chz shz cv sv + temp-obj block-obj ks-data ks-ein ks-aus + p-ein p-aus p-ein-rot p-aus-rot + offset ausgang) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) + (exit) + ) + ) + (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) + (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) + (setq chz (cos rad-hz) shz (sin rad-hz)) + (setq cv (cos rad-vert) sv (sin rad-vert)) + ;; KS-Positionen aus Cache (Block bei 0 Grad am Ursprung) + (setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) + (setq ks-data (extract-ks-from-block temp-obj)) + (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) + (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) + ;; Block einfuegen und rotieren + (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) + (vla-TransformBy block-obj (vlax-tmatrix + (list (list (* chz cv) (- shz) (* chz sv) 0) + (list (* shz cv) chz (* shz sv) 0) + (list (- sv) 0 cv 0) + (list 0 0 0 1)))) + (if (and ks-ein ks-aus) + (progn + (setq p-ein (car ks-ein)) + (setq p-aus (car ks-aus)) + ;; Rotation auf KS-Punkte anwenden: p' = Rz(hz)*Ry(vert) * p + (setq p-ein-rot + (list (+ (* chz cv (car p-ein)) (- (* shz (cadr p-ein))) (* chz sv (caddr p-ein))) + (+ (* shz cv (car p-ein)) (* chz (cadr p-ein)) (* shz sv (caddr p-ein))) + (+ (* (- sv) (car p-ein)) (* cv (caddr p-ein))))) + (setq p-aus-rot + (list (+ (* chz cv (car p-aus)) (- (* shz (cadr p-aus))) (* chz sv (caddr p-aus))) + (+ (* shz cv (car p-aus)) (* chz (cadr p-aus)) (* shz sv (caddr p-aus))) + (+ (* (- sv) (car p-aus)) (* cv (caddr p-aus))))) + ;; Block verschieben: rotiertes KS_EIN auf startpunkt + (vla-Move block-obj + (vlax-3D-point p-ein-rot) + (vlax-3D-point startpunkt)) + (setq offset (list (- (car startpunkt) (car p-ein-rot)) + (- (cadr startpunkt) (cadr p-ein-rot)) + (- (caddr startpunkt) (caddr p-ein-rot)))) + (setq ausgang (list (+ (car p-aus-rot) (car offset)) + (+ (cadr p-aus-rot) (cadr offset)) + (+ (caddr p-aus-rot) (caddr offset)))) + (princ (strcat "\n HzRotKS " blockname + " hz=" (rtos hz-winkel 2 0) (chr 176) + " -> Z=" (rtos (caddr ausgang) 2 1))) + ausgang + ) + (progn + (princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt")) + startpunkt + ) + ) +) + +(defun insert-hz-scaled-block-by-ks (blockname startpunkt laenge hz-winkel vert-winkel / + rad-hz rad-vert chz shz cv sv scale + temp-obj block-obj ks-data ks-ein ks-aus + p-ein p-aus p-ein-s p-aus-s + p-ein-rot p-aus-rot offset ausgang) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek - abgebrochen")) + (exit) + ) + ) + (setq scale (/ (float laenge) 1000.0)) + (setq rad-hz (* (float hz-winkel) (/ pi 180.0))) + (setq rad-vert (* (float vert-winkel) (/ pi 180.0))) + (setq chz (cos rad-hz) shz (sin rad-hz)) + (setq cv (cos rad-vert) sv (sin rad-vert)) + ;; KS bei Massstab 1 + (setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) + (setq ks-data (extract-ks-from-block temp-obj)) + (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) + (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) + ;; Block mit XScale einfuegen und rotieren + (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname scale 1.0 1.0 0)) + (vla-TransformBy block-obj (vlax-tmatrix + (list (list (* chz cv) (- shz) (* chz sv) 0) + (list (* shz cv) chz (* shz sv) 0) + (list (- sv) 0 cv 0) + (list 0 0 0 1)))) + (if (and ks-ein ks-aus) + (progn + (setq p-ein (car ks-ein)) + (setq p-aus (car ks-aus)) + ;; X-Skalierung anwenden + (setq p-ein-s (list (* scale (car p-ein)) (cadr p-ein) (caddr p-ein))) + (setq p-aus-s (list (* scale (car p-aus)) (cadr p-aus) (caddr p-aus))) + ;; Rotation: p' = Rz(hz)*Ry(vert) * p + (setq p-ein-rot + (list (+ (* chz cv (car p-ein-s)) (- (* shz (cadr p-ein-s))) (* chz sv (caddr p-ein-s))) + (+ (* shz cv (car p-ein-s)) (* chz (cadr p-ein-s)) (* shz sv (caddr p-ein-s))) + (+ (* (- sv) (car p-ein-s)) (* cv (caddr p-ein-s))))) + (setq p-aus-rot + (list (+ (* chz cv (car p-aus-s)) (- (* shz (cadr p-aus-s))) (* chz sv (caddr p-aus-s))) + (+ (* shz cv (car p-aus-s)) (* chz (cadr p-aus-s)) (* shz sv (caddr p-aus-s))) + (+ (* (- sv) (car p-aus-s)) (* cv (caddr p-aus-s))))) + ;; Block verschieben + (vla-Move block-obj + (vlax-3D-point p-ein-rot) + (vlax-3D-point startpunkt)) + (setq offset (list (- (car startpunkt) (car p-ein-rot)) + (- (cadr startpunkt) (cadr p-ein-rot)) + (- (caddr startpunkt) (caddr p-ein-rot)))) + (setq ausgang (list (+ (car p-aus-rot) (car offset)) + (+ (cadr p-aus-rot) (cadr offset)) + (+ (caddr p-aus-rot) (caddr offset)))) + (princ (strcat "\n HzScaleKS " blockname + " " (rtos laenge 2 0) "mm" + " hz=" (rtos hz-winkel 2 0) (chr 176) + " -> Z=" (rtos (caddr ausgang) 2 1))) + ausgang + ) + (progn + (princ (strcat "\n WARNUNG: KS fehlt in '" blockname "' - verwende Startpunkt")) + startpunkt + ) + ) +) + +;; ============================================================ +;; TEIL 4: WINKELBERECHNUNG (ETAGE) +;; ============================================================ +(defun berechne-winkel-etage (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 abs-dz-GEF + L_GF L_VF cosα sinα + winkel-eff cosEff sinEff rad5 rad7 + winkel mass1 mass2 gueltig + best-winkel best-L_GF best-L_VF + feste-gesamt-cos feste-gesamt-sin + schraeg-hz-rad schraeg-cos schraeg-z) + + (if (not *etage-lib-initialized*) + (progn + (alert "Etage-Bibliothek nicht initialisiert!") + (exit) + ) + ) + + (setq abs-dz-AUS (abs etage-aus-dz) + abs-dz-EIN (abs etage-ein-dz) + abs-dz-GEF (abs etage-gef-dz)) + + (setq winkel-list '(3 6 9 12 15 18 21 27 33 39 45 51)) + (setq ergebnis-liste '()) + (setq cos3 (cos (* 3.0 (/ pi 180.0))) + sin3 (sin (* 3.0 (/ pi 180.0)))) + + (setq feste-gesamt-cos (* FESTE_ETAGE_MITTE cos3)) + (setq feste-gesamt-sin (* FESTE_ETAGE_MITTE sin3)) + (setq schraeg-hz-rad (* (float ETAGE_HZ_WINKEL) (/ pi 180.0))) + (setq schraeg-cos (* (cos schraeg-hz-rad) cos3)) + + (princ "\n\n=========================================") + (princ "\n ETAGE-BERECHNUNG FUER ALLE WINKEL") + (princ "\n=========================================") + (princ (strcat "\n△L=" (rtos deltaL 2 2) " mm" + " △H=" (rtos deltaH 2 2) " mm" + " Richtung=" richtung)) + + (foreach winkel winkel-list + (if (= richtung "Auf") + (progn + (setq mass1 (get-bogen-mass bogen-auf winkel)) + (setq mass2 (get-bogen-mass bogen-ab winkel)) + ) + (progn + (setq mass1 (get-bogen-mass bogen-ab winkel)) + (setq mass2 (get-bogen-mass bogen-auf winkel)) + ) + ) + (if (or (null mass1) (null mass2)) + (progn + (princ (strcat "\n " (itoa winkel) (chr 176) " -> Bogen nicht vorhanden")) + (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste)) + ) + (progn + (setq rad5 (* 3.0 (/ pi 180.0))) + (setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3))) + (/ pi 180.0))) + (setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5)))) + (setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5)))) + (setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7)))) + (setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7)))) + (setq cosα (cos (* winkel (/ pi 180.0))) + sinα (sin (* winkel (/ pi 180.0)))) + (setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3))) + (setq cosEff (cos (* winkel-eff (/ pi 180.0))) + sinEff (sin (* winkel-eff (/ pi 180.0)))) + ;; A: horizontaler Rest nach Abzug aller festen Teile + (setq A (- deltaL + etage-aus-dx + etage-ein-dx + (* 2.0 ETAGE_SCHRAEG_LAENGE schraeg-cos) + (* 2.0 etage-gef-dx) + bogen-x1 + bogen-x2 + (* 2.0 feste-gesamt-cos))) + ;; B: vertikaler Rest (Vorzeichen analog Standard) + (setq schraeg-z (* ETAGE_SCHRAEG_LAENGE sin3)) + (if (= richtung "Auf") + (setq B (+ deltaH + abs-dz-AUS + abs-dz-EIN + (* 2.0 schraeg-z) + (* 2.0 abs-dz-GEF) + (- bogen-z1) + (- bogen-z2) + (* 2.0 feste-gesamt-sin))) + (setq B (+ (- deltaH + abs-dz-AUS + abs-dz-EIN + (* 2.0 schraeg-z) + (* 2.0 abs-dz-GEF) + (* 2.0 feste-gesamt-sin)) + bogen-z1 + bogen-z2)) + ) + (if (> (abs sinα) 0.0001) + (progn + (setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα)) + (if (= richtung "Auf") + (setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα)) + (setq L_VF (/ (- (* B cos3) (* A sin3)) sinα)) + ) + (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=================================================================================") + (princ "\n ERGEBNISTABELLE (L_GF = gesamt beider GF-Strecken)") + (princ "\n=================================================================================") + (princ "\n Winkel L_GF (mm) L_VF (mm) Status") + (princ "\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) (chr 176) + " " (fmt L_GF) " mm " (fmt L_VF) " mm ")) + (if gueltig + (progn + (princ "GUELTIG") + (if (or (null best-winkel) (< winkel best-winkel)) + (setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF) + ) + ) + (princ "UNGUELTIG (negative Laenge)") + ) + ) + (princ (strcat "\n " (itoa winkel) (chr 176) + " --- --- FEHLER")) + ) + ) + (princ "\n=================================================================================") + (if best-winkel + (princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176))) + (princ "\n>>> KEIN passender Winkel gefunden!") + ) + (list best-winkel best-L_GF best-L_VF ergebnis-liste) +) + +;; ============================================================ +;; TEIL 5: BERECHNE-WRAPPER (Schnittstelle fuer Registry) +;; ============================================================ +;; Initialisiert Etage-Bibliothek, aktiviert Gefaellebogen-Masse +;; passend zur gewaehlten Seite (benoetigt fuer Geometrieberechnung). +(defun berechne-etage (deltaL deltaH richtung seite) + (init-bibliothek-etage) + (if (= seite "rechts") + (progn + (setq etage-gef-dx etage-gef-dx-rechts) + (setq etage-gef-dz etage-gef-dz-rechts)) + (progn + (setq etage-gef-dx etage-gef-dx-links) + (setq etage-gef-dz etage-gef-dz-links)) + ) + (princ (strcat "\n Gefaellebogen " seite + ": dx=" (rtos etage-gef-dx 2 2) " mm")) + (berechne-winkel-etage deltaL deltaH richtung) +) + +;; ============================================================ +;; TEIL 6: EINFUEGEN (15 Schritte, ohne VF_*-Block-Erstellung) +;; ============================================================ +;; Gibt endpunkt zurueck. +;; VF_*-Block-Erstellung erfolgt zentral im Dispatcher (vf_core.lsp). +(defun etage-foerderanlage-einfuegen (deltaL deltaH richtung + best-winkel L_GF1 L_GF2 L_VF + startpunkt seite + / aktueller-punkt bogen-name endpunkt + bogen-mass bogen-dx bogen-dz + as-block es-block gefaelle-blockname + hz-vorzeichen hz-anfang hz-ende) + (setq aktueller-punkt startpunkt) + ;; Horizontalwinkel-Vorzeichen je nach Seite: + ;; rechts: Anfang +60 Grad (links), Ende -60 Grad (rechts) + ;; links: Anfang -60 Grad, Ende +60 Grad + (setq hz-vorzeichen (if (= seite "rechts") 1 -1)) + (setq hz-anfang (* hz-vorzeichen ETAGE_HZ_WINKEL)) + (setq hz-ende (* (- hz-vorzeichen) ETAGE_HZ_WINKEL)) + (setq as-block (strcat "_3D_AS_30_" seite)) + (setq es-block (strcat "_3D_ES_30_" seite)) + (setq gefaelle-blockname + (if (= seite "rechts") + (strcat "Gefaellebogen_rechts_60" grad-zeichen "_R500") + (strcat "Gefaellebogen_links_60" grad-zeichen "_R500") + )) + ;; Sentinel: Bibliothek neu initialisieren wenn Bloecke fehlen + (if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "_3D_AS_30_rechts"))) + (setq *etage-lib-initialized* nil)) + (if (not *etage-lib-initialized*) (init-bibliothek-etage)) + + ;; 1. AS_30 + (princ (strcat "\n\n1/15: " as-block " (0 Grad)")) + (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt)) + + ;; 2. Staustrecke 400mm (hz-anfang, 3 Grad vert, KS_EIN) + (princ (strcat "\n\n2/15: Staustrecke 400mm (" + (itoa hz-anfang) " Grad hz, 3 Grad vert, KS_EIN)")) + (setq aktueller-punkt + (insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt + 400 hz-anfang 3)) + + ;; 3. Separator (hz-anfang, 3 Grad vert) + (princ (strcat "\n\n3/15: Separator (300mm, " + (itoa hz-anfang) " Grad hz, 3 Grad vert)")) + (setq aktueller-punkt + (insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt + hz-anfang 3 300 0)) + + ;; 4. Gefaellebogen Anfang (hz-anfang, 0 Grad vert, KS_EIN) + (princ (strcat "\n\n4/15: " gefaelle-blockname + " (Anfang, " (itoa hz-anfang) " Grad hz, 0 Grad vert, KS_EIN)")) + (setq aktueller-punkt + (insert-hz-rotated-block-by-ks gefaelle-blockname aktueller-punkt hz-anfang 0)) + + ;; 5. L_GF1 (3 Grad geneigt) + (if (> L_GF1 0.1) + (progn + (princ (strcat "\n\n5/15: Gefaellestrecke (3 Grad, L=" (rtos L_GF1 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF1 3)) + ) + (princ "\n\n5/15: L_GF1 (uebersprungen)") + ) + + ;; 6. Umlenkstation (3 Grad geneigt) + (princ "\n\n6/15: Umlenkstation (500mm, 3 Grad geneigt)") + (setq aktueller-punkt + (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt 3 500 0)) + + ;; 7. 1. Vertikalbogen (3 Grad geneigt) + (if (= richtung "Auf") + (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\n7/15: " bogen-name " (3 Grad geneigt)")) + (setq aktueller-punkt + (insert-rotated-block-with-ks bogen-name aktueller-punkt 3 bogen-dx bogen-dz)) + + ;; 8. Variable Strecke L_VF + (if (> L_VF 0.1) + (progn + (if (= richtung "Auf") + (progn + (princ (strcat "\n\n8/15: Steigungsstrecke (" + (itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt + L_VF (- (- best-winkel 3)))) + ) + (progn + (princ (strcat "\n\n8/15: Gefaellestrecke (" + (itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt + L_VF (+ best-winkel 3))) + ) + ) + ) + (princ "\n\n8/15: L_VF (uebersprungen)") + ) + + ;; 9. 2. Vertikalbogen + (if (= richtung "Auf") + (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)) + ) + ) + (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass)) + (if (= richtung "Auf") + (progn + (princ (strcat "\n\n9/15: " bogen-name + " (" (itoa (- 3 best-winkel)) " Grad geneigt)")) + (setq aktueller-punkt + (insert-rotated-block-with-ks bogen-name aktueller-punkt + (- 3 best-winkel) bogen-dx bogen-dz)) + ) + (progn + (princ (strcat "\n\n9/15: " bogen-name + " (" (itoa (+ best-winkel 3)) " Grad geneigt)")) + (setq aktueller-punkt + (insert-rotated-block-with-ks bogen-name aktueller-punkt + (+ best-winkel 3) bogen-dx bogen-dz)) + ) + ) + + ;; 10. Motorstation (3 Grad geneigt) + (princ "\n\n10/15: Motorstation (500mm, 3 Grad geneigt)") + (setq aktueller-punkt + (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt 3 500 0)) + + ;; 11. L_GF2 (3 Grad geneigt) + (if (> L_GF2 0.1) + (progn + (princ (strcat "\n\n11/15: Gefaellestrecke (3 Grad, L=" (rtos L_GF2 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt L_GF2 3)) + ) + (princ "\n\n11/15: L_GF2 (uebersprungen)") + ) + + ;; 12. Gefaellebogen Ende (via KS_EIN, 0 Grad vert) + (princ (strcat "\n\n12/15: " gefaelle-blockname " (Ende, KS_EIN)")) + (setq aktueller-punkt (insert-block-by-ks gefaelle-blockname aktueller-punkt)) + + ;; 13. Separator Ende (hz-ende, 3 Grad vert) + (princ (strcat "\n\n13/15: Separator (300mm, " + (itoa hz-ende) " Grad hz, 3 Grad vert)")) + (setq aktueller-punkt + (insert-hz-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt + hz-ende 3 300 0)) + + ;; 14. Staustrecke 400mm Ende (hz-ende, 3 Grad vert, KS_EIN) + (princ (strcat "\n\n14/15: Staustrecke 400mm (" + (itoa hz-ende) " Grad hz, 3 Grad vert, KS_EIN)")) + (setq aktueller-punkt + (insert-hz-scaled-block-by-ks "Staustrecke_SP_1000_mm" aktueller-punkt + 400 hz-ende 3)) + + ;; 15. ES_30 (hz-ende, 0 Grad vert) + (princ (strcat "\n\n15/15: " es-block + " (Ende, " (itoa hz-ende) " Grad hz, 0 Grad vert)")) + (setq endpunkt + (insert-hz-rotated-block-with-ks es-block aktueller-punkt + hz-ende 0 etage-ein-dx etage-ein-dz)) + + (princ "\n\n=========================================") + (princ "\n>>> Etage-VarioFoerderer eingefuegt! <<<") + endpunkt +) + +;; ============================================================ +;; REGISTRIERUNG +;; ============================================================ +(vf-typ-registrieren + "etage" + 'berechne-etage + 'etage-foerderanlage-einfuegen + "Etage VarioFoerderer (AS/ES 30 Grad, direkt uebereinander)") + +(princ "\n>>> vf_etage.lsp geladen - Typ 'etage' registriert") +(princ) diff --git a/Lisp/vf_standard.lsp b/Lisp/vf_standard.lsp new file mode 100644 index 0000000..19351bf --- /dev/null +++ b/Lisp/vf_standard.lsp @@ -0,0 +1,499 @@ +;; ============================================================ +;; VF_STANDARD - Standard VarioFoerderer (Typ: "standard") +;; Version: 26.0 +;; Abhaengigkeit: vf_core.lsp muss zuerst geladen sein +;; Geometrie: AS/ES 90 Grad, horizontal versetzt +;; 11-Schritt-Einfuegung +;; ============================================================ + +;; Sicherstellen, dass vf_core.lsp geladen ist +(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN")))) + (if (getenv "DXFM_LISP") + (load (strcat (getenv "DXFM_LISP") "/vf_core.lsp")) + (progn + (alert "DXFM_LISP nicht gesetzt! Bitte zuerst bin\\setenv.bat ausfuehren.") + (exit) + ) + ) +) + +;; ============================================================ +;; TEIL 1: STANDARD-SPEZIFISCHE GLOBALE VARIABLEN +;; ============================================================ +(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) + +(setq bogen-auf '()) +(setq bogen-ab '()) + +(setq *lib-initialized* nil) +(setq *bogen-cache-loaded* nil) +(setq *modul-cache* nil) + +;; ============================================================ +;; TEIL 2: BIBLIOTHEK INITIALISIEREN +;; ============================================================ +(defun init-bibliothek ( / temp-obj bogen-winkel ks-data ks-ein-pos ks-aus-pos + dx dy dz bogen-name) + (if (and *lib-initialized* (tblsearch "BLOCK" "_3D_AS_90_links")) + (progn + (princ "\n Standard-Bibliothek bereits initialisiert.") + t + ) + (progn + (setq *lib-initialized* nil) + (setq *ks-cache* nil) + (princ "\n Initialisiere Standard-Bibliothek...") + + ;; AS_90 Masse extrahieren + (princ "\n Extrahiere AUS_Element Masse...") + (ensure-block-loaded "_3D_AS_90_links") + (ensure-block-loaded "_3D_AS_90_rechts") + (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 (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq aus-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) + (setq aus-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + (princ (strcat "\n AS_90: dx=" (rtos aus-dx 2 0) + " dz=" (rtos aus-dz 2 0))) + ) + (princ "\n FEHLER: KS_EIN/KS_AUS fehlt im AS_90!") + ) + ) + (princ "\n FEHLER: Block _3D_AS_90_links nicht geladen!") + ) + + ;; ES_90 Masse extrahieren + (princ "\n Extrahiere EIN_Element Masse...") + (ensure-block-loaded "_3D_ES_90_links") + (ensure-block-loaded "_3D_ES_90_rechts") + (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 (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq ein-dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) + (setq ein-dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + (princ (strcat "\n ES_90: dx=" (rtos ein-dx 2 0) + " dz=" (rtos ein-dz 2 0))) + ) + (princ "\n FEHLER: KS_EIN/KS_AUS fehlt im ES_90!") + ) + ) + (princ "\n FEHLER: Block _3D_ES_90_links nicht geladen!") + ) + + ;; Bogen-Masse extrahieren + (princ "\n Extrahiere Bogen-Masse...") + (setq bogen-auf '()) + (setq bogen-ab '()) + (setq bogen-winkel (ssg-cfg-or "vario" "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 (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) + (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + (setq bogen-auf (cons (list w dx dy dz) bogen-auf)) + (princ (strcat "\n OK auf_" (itoa w) + ": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0))) + ) + (princ (strcat "\n FEHLER auf_" (itoa w) ": KS fehlt!")) + ) + ) + (princ (strcat "\n FEHLER 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 (- (caar ks-aus-pos) (caar ks-ein-pos))) + (setq dy (- (cadr (car ks-aus-pos)) (cadr (car ks-ein-pos)))) + (setq dz (- (caddr (car ks-aus-pos)) (caddr (car ks-ein-pos)))) + (setq bogen-ab (cons (list w dx dy dz) bogen-ab)) + (princ (strcat "\n OK ab_" (itoa w) + ": dx=" (rtos dx 2 0) " dz=" (rtos dz 2 0))) + ) + (princ (strcat "\n FEHLER ab_" (itoa w) ": KS fehlt!")) + ) + ) + (princ (strcat "\n FEHLER ab_" (itoa w) ": Block nicht geladen!")) + ) + ) + (setq bogen-auf (reverse bogen-auf)) + (setq bogen-ab (reverse bogen-ab)) + (setq *lib-initialized* t) + (princ "\n Standard-Bibliothek erfolgreich initialisiert.") + t + ) + ) +) + +;; ============================================================ +;; TEIL 3: BOGEN-MASSE +;; ============================================================ +(defun get-bogen-mass (tabelle winkel) + (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!")) + ) + result +) + +;; ============================================================ +;; TEIL 4: WINKELBERECHNUNG +;; ============================================================ +(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α + winkel-eff cosEff sinEff rad5 rad7 + winkel mass1 mass2 gueltig + best-winkel best-L_GF best-L_VF) + + (if (not *lib-initialized*) + (progn + (alert "Bibliothek nicht initialisiert!") + (exit) + ) + ) + + (setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz)) + (setq winkel-list (ssg-cfg-or "vario" "bogen_winkel" + '(3 6 9 12 15 18 21 27 33 39 45 51))) + (setq ergebnis-liste '()) + (setq cos3 (cos (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))) + sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0)))) + + (princ "\n\n=========================================") + (princ "\n BERECHNUNG FUER ALLE WINKEL (Standard)") + (princ "\n=========================================") + (princ (strcat "\n△L=" (rtos deltaL 2 2) " mm" + " △H=" (rtos deltaH 2 2) " mm" + " Richtung=" richtung)) + + (foreach winkel winkel-list + (if (= richtung "Auf") + (progn + (setq mass1 (get-bogen-mass bogen-auf winkel)) + (setq mass2 (get-bogen-mass bogen-ab winkel)) + ) + (progn + (setq mass1 (get-bogen-mass bogen-ab winkel)) + (setq mass2 (get-bogen-mass bogen-auf winkel)) + ) + ) + (if (or (null mass1) (null mass2)) + (setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste)) + (progn + (setq rad5 (* 3.0 (/ pi 180.0))) + (setq rad7 (* (float (if (= richtung "Auf") (- 3 winkel) (+ winkel 3))) + (/ pi 180.0))) + (setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5)))) + (setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5)))) + (setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7)))) + (setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7)))) + (setq cosα (cos (* winkel (/ pi 180.0))) + sinα (sin (* winkel (/ pi 180.0)))) + (setq A (- deltaL aus-dx ein-dx bogen-x1 bogen-x2 + (* FESTE_HORIZONTAL cos3))) + (setq winkel-eff (if (= richtung "Auf") (- winkel 3) (+ winkel 3))) + (setq cosEff (cos (* winkel-eff (/ pi 180.0))) + sinEff (sin (* winkel-eff (/ pi 180.0)))) + (if (= richtung "Auf") + (setq B (+ deltaH abs-dz-AUS abs-dz-EIN + (- bogen-z1) (- bogen-z2) + (* FESTE_HORIZONTAL sin3))) + (setq B (+ (- deltaH abs-dz-AUS abs-dz-EIN + (* FESTE_HORIZONTAL sin3)) + bogen-z1 bogen-z2)) + ) + (if (> (abs sinα) 0.0001) + (progn + (setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα)) + (if (= richtung "Auf") + (setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα)) + (setq L_VF (/ (- (* B cos3) (* A sin3)) sinα)) + ) + (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=================================================================================") + (princ "\n ERGEBNISTABELLE") + (princ "\n=================================================================================") + (princ "\n Winkel L_GF (mm) L_VF (mm) Status") + (princ "\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) (chr 176) + " " (fmt L_GF) " mm " (fmt L_VF) " mm ")) + (if gueltig + (progn + (princ "GUELTIG") + (if (or (null best-winkel) (< winkel best-winkel)) + (setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF) + ) + ) + (princ "UNGUELTIG (negative Laenge)") + ) + ) + (princ (strcat "\n " (itoa winkel) (chr 176) + " --- --- FEHLER")) + ) + ) + (princ "\n=================================================================================") + (if best-winkel + (princ (strcat "\n>>> Empfohlener Winkel: " (itoa best-winkel) (chr 176))) + (princ "\n>>> KEIN passender Winkel gefunden!") + ) + (list best-winkel best-L_GF best-L_VF ergebnis-liste) +) + +;; ============================================================ +;; TEIL 5: BERECHNE-WRAPPER (Schnittstelle fuer Registry) +;; ============================================================ +;; Initialisiert Standard-Bibliothek und berechnet Winkel. +;; seite-Parameter wird fuer Standard-Typ nicht benoetigt (keine Vorab-Geometrie). +(defun berechne-standard (deltaL deltaH richtung seite) + (setq FESTE_HORIZONTAL (ssg-cfg-or "vario" "feste_horizontal" 1600)) + (setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000)) + (init-bibliothek) + (berechne-alle-winkel deltaL deltaH richtung) +) + +;; ============================================================ +;; TEIL 6: EINFUEGEN (11 Schritte, ohne VF_*-Block-Erstellung) +;; ============================================================ +;; Gibt endpunkt zurueck (letzter KS_AUS nach ES_90). +;; VF_*-Block-Erstellung erfolgt zentral im Dispatcher (vf_core.lsp). +(defun variofoerderer-einfuegen (deltaL deltaH richtung best-winkel + L_GF1 L_GF2 L_VF startpunkt seite + / aktueller-punkt bogen-name endpunkt + bogen-mass bogen-dx bogen-dz + as-block es-block) + (setq aktueller-punkt startpunkt) + (setq as-block (strcat "_3D_AS_90_" seite)) + (setq es-block (strcat "_3D_ES_90_" seite)) + (if (not *lib-initialized*) (init-bibliothek)) + + ;; 1. AUS_Element + (princ (strcat "\n\n1/11: " as-block " (0 Grad)")) + (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt)) + + ;; 2. 1. Gefaellestrecke + (if (> L_GF1 0.1) + (progn + (princ (strcat "\n\n2/11: Gefaellestrecke (3 Grad, L=" (rtos L_GF1 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt + L_GF1 (ssg-cfg-or "vario" "gefaelle_winkel" 3))) + ) + (princ "\n\n2/11: (uebersprungen)") + ) + + ;; 3. Separator + (princ "\n\n3/11: Separator (300 mm, 3 Grad geneigt)") + (setq aktueller-punkt + (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt + (ssg-cfg-or "vario" "gefaelle_winkel" 3) + (ssg-cfg-or "vario" "separator_block_dx" 300) + (ssg-cfg-or "vario" "separator_block_dz" 0))) + + ;; 4. Umlenkstation + (princ "\n\n4/11: Umlenkstation (500 mm, 3 Grad geneigt)") + (setq aktueller-punkt + (insert-rotated-block-with-ks "Vario_Umlenkstation_500mm" aktueller-punkt + (ssg-cfg-or "vario" "gefaelle_winkel" 3) + (ssg-cfg-or "vario" "station_block_dx" 500) + (ssg-cfg-or "vario" "station_block_dz" 0))) + + ;; 5. 1. Vertikalbogen + (if (= richtung "Auf") + (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 Grad geneigt)")) + (setq aktueller-punkt + (insert-rotated-block-with-ks bogen-name aktueller-punkt + (ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz)) + + ;; 6. Variable Strecke L_VF + (if (> L_VF 0.1) + (progn + (if (= richtung "Auf") + (progn + (princ (strcat "\n\n6/11: Steigungsstrecke (" + (itoa (- (- best-winkel 3))) " Grad, L=" (rtos L_VF 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt + L_VF (- (- best-winkel 3)))) + ) + (progn + (princ (strcat "\n\n6/11: Gefaellestrecke (" + (itoa (+ best-winkel 3)) " Grad, L=" (rtos L_VF 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt + L_VF (+ best-winkel 3))) + ) + ) + ) + (princ "\n\n6/11: (uebersprungen)") + ) + + ;; 7. 2. Vertikalbogen + (if (= richtung "Auf") + (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)) + ) + ) + (setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass)) + (if (= richtung "Auf") + (progn + (princ (strcat "\n\n7/11: " bogen-name + " (" (itoa (- 3 best-winkel)) " Grad geneigt)")) + (setq aktueller-punkt + (insert-rotated-block-with-ks bogen-name aktueller-punkt + (- 3 best-winkel) bogen-dx bogen-dz)) + ) + (progn + (princ (strcat "\n\n7/11: " bogen-name + " (" (itoa (+ best-winkel 3)) " Grad geneigt)")) + (setq aktueller-punkt + (insert-rotated-block-with-ks bogen-name aktueller-punkt + (+ best-winkel 3) bogen-dx bogen-dz)) + ) + ) + + ;; 8. Motorstation + (princ "\n\n8/11: Motorstation (500 mm, 3 Grad geneigt)") + (setq aktueller-punkt + (insert-rotated-block-with-ks "Vario_Motorstation_500mm" aktueller-punkt + (ssg-cfg-or "vario" "gefaelle_winkel" 3) + (ssg-cfg-or "vario" "station_block_dx" 500) + (ssg-cfg-or "vario" "station_block_dz" 0))) + + ;; 9. 2. Gefaellestrecke + (if (> L_GF2 0.1) + (progn + (princ (strcat "\n\n9/11: Gefaellestrecke (3 Grad, L=" (rtos L_GF2 2 2) " mm)")) + (setq aktueller-punkt + (insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt + L_GF2 (ssg-cfg-or "vario" "gefaelle_winkel" 3))) + ) + (princ "\n\n9/11: (uebersprungen)") + ) + + ;; 10. Separator 2 + (princ "\n\n10/11: Separator (300 mm, 3 Grad geneigt)") + (setq aktueller-punkt + (insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt + (ssg-cfg-or "vario" "gefaelle_winkel" 3) + (ssg-cfg-or "vario" "separator_block_dx" 300) + (ssg-cfg-or "vario" "separator_block_dz" 0))) + + ;; 11. EIN_Element + (princ (strcat "\n\n11/11: " es-block " (0 Grad)")) + (setq endpunkt (insert-block-by-ks es-block aktueller-punkt)) + + (princ "\n\n=========================================") + (princ "\n>>> Standard VarioFoerderer eingefuegt!") + endpunkt +) + +;; ============================================================ +;; REGISTRIERUNG +;; ============================================================ +(vf-typ-registrieren + "standard" + 'berechne-standard + 'variofoerderer-einfuegen + "Standard VarioFoerderer (AS/ES 90 Grad, horizontal versetzt)") + +(princ "\n>>> vf_standard.lsp geladen - Typ 'standard' registriert") +(princ) diff --git a/data/block_libraries/ils_library.dxf b/data/block_libraries/ils_library.dxf index bb5a1c7..f88c86f 100644 Binary files a/data/block_libraries/ils_library.dxf and b/data/block_libraries/ils_library.dxf differ