diff --git a/Lisp/VarioFoerderer.lsp b/Lisp/VarioFoerderer.lsp index 01c3637..28c9418 100644 --- a/Lisp/VarioFoerderer.lsp +++ b/Lisp/VarioFoerderer.lsp @@ -1,4 +1,4 @@ -;; ============================================================ +============================================================ ;; FÖRDERANLAGE GENERATOR für BricsCAD Pro ;; Version: 24.3 (Korrigierte Methodenzuordnung) ;; Befehl: FOERDERANLAGE @@ -7,50 +7,24 @@ (vl-load-com) ;; ============================================================ -;; BLOCK PATH INITIALIZATION +;; TEIL 1: GLOBALE EINSTELLUNGEN ;; ============================================================ - -;; ============================================ -;; Automatische Umgebungsvariablen Konfiguration -;; ============================================ - -;; Basis-Pfad (an Ihre Struktur anpassen) -(setq *dxfm-base* "C:\\Users\\y.wang\\Documents\\dxfmakros\\") - -;; Funktion zum sicheren Setzen von Umgebungsvariablen -(defun ensure-env-var (varName defaultPath) - (if (null (getenv varName)) - (progn - (setenv varName defaultPath) - (princ (strcat "\n✅ " varName " gesetzt: " defaultPath)) - ) - (princ (strcat "\n📌 " varName " bereits gesetzt: " (getenv varName))) - ) - (getenv varName) -) - -;; Umgebungsvariablen sicherstellen -(ensure-env-var "DXFM_BLOCKS" (strcat *dxfm-base* "Blocks\\")) -(ensure-env-var "DXFM_DATA" (strcat *dxfm-base* "Data\\")) - -;; Block-Pfad initialisieren (für draw-module) -(setq *block-pfad* (getenv "DXFM_BLOCKS")) - -;; Koordinaten-Bibliothek initialisieren (mit Fallback) -(setq koordinaten-lib - (if (getenv "DXFM_DATA") - (strcat (getenv "DXFM_DATA") "block_libraries\\ils_vario_koordinaten.dwg") - (strcat *dxfm-base* "Data\\block_libraries\\ils_vario_koordinaten.dwg") +(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) ) ) -;; Prüfen ob Koordinaten-Bibliothek existiert -(if (findfile koordinaten-lib) - (princ (strcat "\n✅ Koordinaten-Bibliothek: " koordinaten-lib)) - (princ (strcat "\n⚠️ Koordinaten-Bibliothek nicht gefunden: " koordinaten-lib)) +;; Pfad zur Koordinaten-Bibliothek (neue Bogen-Bloecke mit KS_EIN/KS_AUS) +(if (getenv "DXFM_DATA") + (setq koordinaten-lib (strcat (getenv "DXFM_DATA") "/block_libraries/ils_vario_koordinaten.dwg")) + (progn + (alert "Umgebungsvariable DXFM_DATA nicht gesetzt!\nBitte zuerst bin\\setenv.bat ausfuehren.") + (exit) + ) ) - -(princ "\n=== Umgebungsvariablen initialisiert ===\n") (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq modelspace (vla-get-ModelSpace doc)) @@ -72,11 +46,11 @@ (setq FESTE_HORIZONTAL 1600) ;; ============================================================ -;; KONFIGURATION: Flag fuer dynamische Bogen-Tabellen -;; t = dynamisch aus KS_EIN/KS_AUS der Koordinaten-Bibliothek -;; nil = feste, hartkodierte Werte (Fallback) +;; KONFIGURATION: Flag für dynamische BoundingBox-Berechnung +;; Setze auf t für dynamische Berechnung aus .dwg-Dateien +;; Setze auf nil für feste, hartkodierte Werte ;; ============================================================ -(setq use-dynamic-bbox nil) ;; t = dynamisch, nil = hartkodiert +(setq use-dynamic-bbox nil) ;; Ändere hier: t = dynamisch, nil = hartkodiert ;; ============================================================ ;; Feste, hartkodierte Bogen-Tabellen (Fallback) @@ -127,9 +101,74 @@ ) ) +;; ============================================================ +;; Funktion zum Erstellen der Bogen-Tabellen dynamisch +;; ============================================================ +(defun create-bogen-table (richtung unten-oben / winkel-list table bbox) + (setq winkel-list '(3 9 12 15 24 36 48)) + (setq table '()) + (foreach winkel winkel-list + (setq blockname (strcat modul-pfad "Vertikalbogen_" richtung "_" (itoa winkel) "_" unten-oben ".dwg")) + (setq bbox (get-block-bbox blockname)) + (if (and (> (car bbox) 0) (> (caddr bbox) 0)) ;; Nur gültige Werte + (setq table (cons (cons winkel bbox) table)) + (princ (strcat "\nWARNUNG: Ungültige BoundingBox für " blockname)) + ) + ) + (reverse table) +) + +;; ============================================================ +;; TEIL 3: BOGEN-MASSE (Verzweigung basierend auf Flag) +;; ============================================================ +(if use-dynamic-bbox + (progn + (princ "\nVerwende dynamische BoundingBox-Berechnung für Bogen-Tabellen...") + (if (null bogen-auf-unten) + (progn + (setq bogen-auf-unten (create-bogen-table "Auf" "Unten")) + (setq bogen-auf-oben (create-bogen-table "Auf" "Oben")) + (setq bogen-ab-oben (create-bogen-table "Ab" "Oben")) + (setq bogen-ab-unten (create-bogen-table "Ab" "Unten")) + (princ "\nDynamische Bogen-Tabellen initialisiert.") + ) + ) + ) + (progn + (princ "\nVerwende hartkodierte Werte für Bogen-Tabellen...") + (setq bogen-auf-unten bogen-auf-unten-hardcoded) + (setq bogen-auf-oben bogen-auf-oben-hardcoded) + (setq bogen-ab-oben bogen-ab-oben-hardcoded) + (setq bogen-ab-unten bogen-ab-unten-hardcoded) + (princ "\nHartkodierte Bogen-Tabellen geladen.") + ) +) + +;; ============================================================ +;; TEIL 4: HILFSFUNKTIONEN +;; ============================================================ +(defun punkt-differenz (p1 p2) + (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1))) +) + +(defun get-bogen-mass (tabelle winkel) + (setq result nil) + (foreach item tabelle (if (= (car item) winkel) (setq result (cdr item)))) + (if (null result) (setq result '(800 0 0))) result +) + +(defun get-bogen-mass-mit-abs (tabelle winkel) + (setq result nil) + (foreach item tabelle (if (= (car item) winkel) (setq result (list (cadr item) (caddr item) (abs (cadddr item)))))) + (if (null result) (setq result '(800 0 0))) result +) + +(defun fmt (x) + (if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---") +) + ;; ============================================================ ;; TEIL 4b: KS_EIN / KS_AUS KOORDINATEN EXTRAHIEREN -;; (vor create-bogen-table, da dort benoetigt) ;; ============================================================ ;; Grad-Zeichen fuer Blocknamen @@ -296,110 +335,6 @@ ks-results ) -;; ============================================================ -;; Funktion zum Erstellen der Bogen-Tabellen dynamisch -;; Verwendet KS_EIN/KS_AUS aus der Koordinaten-Bibliothek -;; ============================================================ -(defun create-bogen-table (richtung unten-oben / winkel-list table - bogen-name full-name block-obj ks-data - ks-ein-data ks-aus-data ein-origin aus-origin - dx dz richtung-klein) - (setq winkel-list '(3 9 12 15 24 36 48)) - (setq table '()) - ;; Richtung kleingeschrieben fuer Blocknamen (Vario_Bogen_auf_3°) - (setq richtung-klein (if (= richtung "Auf") "auf" "ab")) - - ;; Koordinaten-Bibliothek laden - (load-koordinaten-lib) - - (foreach winkel winkel-list - (setq bogen-name (strcat "Vario_Bogen_" richtung-klein "_" (itoa winkel))) - (setq full-name (strcat bogen-name grad-zeichen)) - - (if (tblsearch "BLOCK" full-name) - (progn - ;; Block temporaer einfuegen bei (0,0,0) - (setq block-obj (vla-InsertBlock modelspace - (vlax-3D-point '(0 0 0)) - full-name 1.0 1.0 1.0 0)) - ;; KS_EIN und KS_AUS extrahieren - (setq ks-data (extract-ks-from-block block-obj)) - ;; Block loeschen - (vla-Delete block-obj) - - (setq ks-ein-data (cadr (assoc "KS_EIN" ks-data))) - (setq ks-aus-data (cadr (assoc "KS_AUS" ks-data))) - - (if (and ks-ein-data ks-aus-data) - (progn - (setq ein-origin (car ks-ein-data)) - (setq aus-origin (car ks-aus-data)) - ;; Offset: KS_AUS - KS_EIN - (setq dx (- (car aus-origin) (car ein-origin))) - (setq dz (- (caddr aus-origin) (caddr ein-origin))) - (princ (strcat "\n " full-name ": dx=" (rtos dx 2 2) " dz=" (rtos dz 2 2))) - (setq table (cons (list winkel dx 0 dz) table)) - ) - (princ (strcat "\nWARNUNG: KS_EIN/KS_AUS nicht gefunden in " full-name)) - ) - ) - (princ (strcat "\nWARNUNG: Block " full-name " nicht in Bibliothek")) - ) - ) - (reverse table) -) - -;; ============================================================ -;; TEIL 3: BOGEN-MASSE (Verzweigung basierend auf Flag) -;; ============================================================ -(if use-dynamic-bbox - (progn - (princ "\nVerwende dynamische KS_EIN/KS_AUS-Berechnung fuer Bogen-Tabellen...") - (if (null bogen-auf-unten) - (progn - (setq bogen-auf-unten (create-bogen-table "Auf" "Unten")) - (setq bogen-auf-oben (create-bogen-table "Auf" "Oben")) - (setq bogen-ab-oben (create-bogen-table "Ab" "Oben")) - (setq bogen-ab-unten (create-bogen-table "Ab" "Unten")) - (princ "\nDynamische Bogen-Tabellen initialisiert.") - ) - ) - ) - (progn - (princ "\nVerwende hartkodierte Werte fuer Bogen-Tabellen...") - (setq bogen-auf-unten bogen-auf-unten-hardcoded) - (setq bogen-auf-oben bogen-auf-oben-hardcoded) - (setq bogen-ab-oben bogen-ab-oben-hardcoded) - (setq bogen-ab-unten bogen-ab-unten-hardcoded) - (princ "\nHartkodierte Bogen-Tabellen geladen.") - ) -) - -;; ============================================================ -;; TEIL 4: HILFSFUNKTIONEN -;; ============================================================ -(defun punkt-differenz (p1 p2) - (list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1))) -) - -(defun get-bogen-mass (tabelle winkel) - (setq result nil) - (foreach item tabelle (if (= (car item) winkel) (setq result (cdr item)))) - (if (null result) (setq result '(800 0 0))) result -) - -(defun get-bogen-mass-mit-abs (tabelle winkel) - (setq result nil) - (foreach item tabelle (if (= (car item) winkel) (setq result (list (cadr item) (caddr item) (abs (cadddr item)))))) - (if (null result) (setq result '(800 0 0))) result -) - -(defun fmt (x) - (if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---") -) - -;; (TEIL 4b wurde nach oben verschoben, vor create-bogen-table) - ;; Bogen-Block aus der Koordinaten-Bibliothek einfuegen und KS-Daten extrahieren. ;; bogen-name = Blockname ohne Grad-Zeichen (z.B. "Vario_Bogen_auf_3") ;; einfuege-punkt = Punkt an dem der Block eingefuegt wird @@ -571,6 +506,51 @@ (list best-winkel best-L_GF best-L_VF ergebnis-liste) ) +;; ============================================================ +;; 3D-Punkt mit korrekter Z-Höhe erfassen (via Objektauswahl) +;; ============================================================ +(defun get-3d-point-from-object (msg / ent pickpt pt) + + (princ msg) + (princ "\n >> Objektpunkt wählen: ") + + (setq ent (entsel)) + + (if ent + (progn + + ;; 鼠标点击点 + (setq pickpt (cadr ent)) + + ;; entity name + (setq obj (vlax-ename->vla-object (car ent))) + + ;; 获取对象上的真实几何点 + (setq realpt + (vlax-curve-getClosestPointTo + obj + pickpt + ) + ) + + (princ + (strcat + "\n ✓ Echter 3D-Punkt:" + "\n X = " (rtos (car realpt) 2 3) + "\n Y = " (rtos (cadr realpt) 2 3) + "\n Z = " (rtos (caddr realpt) 2 3) + ) + ) + + realpt + ) + + (progn + (princ "\n Kein Objekt gewählt.") + nil + ) + ) +) ;; ============================================================ ;; TEIL 6: MODULE EINFÜGEN (mit korrigierter Methodenzuordnung) ;; ============================================================ @@ -941,11 +921,22 @@ (if (= eingabe-modus "Punkt") (progn (princ "\n\n>>> MODUS: Punkte auswählen <<<") + ;; ⬇️⬇️⬇️ NEU: BKS auf WCS setzen ⬇️⬇️⬇️ + (command "BKS" "W") + (princ "\n✓ BKS auf Weltkoordinaten gesetzt - Z-Höhe wird korrekt erfasst!") + ;; ⬆️⬆️⬆️ NEU ⬆️⬆️⬆️ (princ "\nWählen Sie die Einfügepunkte der Elemente.\n") - (setq startpunkt (getpoint "\n1. START-PUNKT (Eingang des AUS_Elements): ")) + (setq startpunkt + (get-3d-point-from-object + "\n1. START-PUNKT (Eingang des AUS_Elements): ")) (if (null startpunkt) (progn (alert "Kein Startpunkt!") (exit))) - (setq endpunkt (getpoint "\n2. END-PUNKT (Ausgang des EIN_Elements): ")) + ;; DEBUG: Prüfen ob Z erfasst wurde + (princ (strcat "\n → Erfasste Z-Höhe: " (rtos (caddr startpunkt) 2 2) " mm")) + (setq endpunkt + (get-3d-point-from-object + "\n2. END-PUNKT (Ausgang des EIN_Elements): ")) (if (null endpunkt) (progn (alert "Kein Endpunkt!") (exit))) + (princ (strcat "\n → Erfasste Z-Höhe Endpunkt: " (rtos (caddr endpunkt) 2 2) " mm")) (setq differenz (punkt-differenz startpunkt endpunkt)) (setq deltaL (abs (car differenz)) deltaY (cadr differenz) deltaH (caddr differenz)) (princ "\n\n=========================================") @@ -1027,6 +1018,7 @@ ) (princ) ) + ;; ============================================================ ;; TEIL 8: FOERDERTEST - Automatischer Test ohne Benutzereingabe ;; Mit tabellarischer Zusammenfassung am Ende @@ -1057,7 +1049,7 @@ (princ "\n║ Nr. Richtung ΔH (mm) Status Winkel L_GF (mm) L_VF (mm) ║") (princ "\n╠══════════════════════════════════════════════════════════════════════════════╣") - ;; ========================================================== + ;; ========================================================== ;; TEIL 1: Aufwärts-Tests (6 Förderer) ;; ========================================================== (foreach deltaH hoehen-liste @@ -1125,7 +1117,7 @@ (setq y-offset (- y-offset 200)) ) - ;; ========================================================== + ;; ========================================================== ;; TEIL 2: Abwärts-Tests (6 Förderer) ;; ========================================================== (foreach deltaH hoehen-liste