;; ============================================================ ;; tests.lsp - Test- und Hilfsfunktionen ;; ============================================================ (defun c:CALLPYTHON ( / log-pfad py-skript return-datei cmd fh zeile) (setq log-pfad (getenv "DXFM_LOG")) (setq py-skript (strcat (getenv "DXFM_LIB") "\\testpycall.py")) (setq return-datei (strcat log-pfad "\\testpycall_return.txt")) (if (findfile py-skript) (progn (setq cmd (strcat "python \"" py-skript "\" \"" log-pfad "\"")) (command "_.SHELL" cmd) (if (findfile return-datei) (progn (setq fh (open return-datei "r")) (setq zeile (read-line fh)) (close fh) (princ (strcat "\n[SSG_LIB] Python Rueckgabe: " zeile)) ) (princ "\n[SSG_LIB] WARNUNG: Keine Rueckgabe von Python erhalten.") ) ) (princ (strcat "\n[SSG_LIB] FEHLER: " py-skript " nicht gefunden!")) ) (princ) ) ;; ============================================================ ;; EXPORT - Relevante INSERT-Entities sammeln und als JSON exportieren ;; Anschliessend Python-Skript aufrufen fuer CSV-Erzeugung ;; ============================================================ ;; --- String fuer JSON escapen (Anfuehrungszeichen/Backslash) --- ;; Nutzt vl-string-subst fuer die haeufigsten Faelle statt ;; zeichenweiser Verkettung (deutlich schneller bei langen Strings). (defun csv:json-escape (s) (setq s (vl-string-subst "\\\\" "\\" s)) (vl-string-subst "\\\"" "\"" s) ) ;; --- Attribute eines INSERT-Blocks als JSON-Objekt lesen --- ;; ename = Entity-Name des INSERT ;; Rueckgabe: String wie {"TAG1":"Wert1","TAG2":"Wert2"} (defun csv:read-attribs (ename / obj ed typ tag wert parts) (setq obj (entnext ename)) (setq parts nil) (while obj (setq ed (entget obj)) (setq typ (cdr (assoc 0 ed))) (if (equal typ "SEQEND") (setq obj nil) (progn (if (equal typ "ATTRIB") (setq parts (cons (strcat "\"" (csv:json-escape (cdr (assoc 2 ed))) "\":\"" (csv:json-escape (cdr (assoc 1 ed))) "\"") parts)) ) (setq obj (entnext obj)) ) ) ) (if parts (progn (setq parts (reverse parts)) (strcat "{" (car parts) (apply 'strcat (mapcar '(lambda (p) (strcat "," p)) (cdr parts))) "}") ) "{}" ) ) ;; --- Einen INSERT-Block als JSON-Objekt schreiben --- (defun csv:block-to-json (ename / ed blk-name layer pt rotation handle attribs) (setq ed (entget ename)) (setq blk-name (cdr (assoc 2 ed))) (setq layer (cdr (assoc 8 ed))) (setq pt (cdr (assoc 10 ed))) (setq rotation (cdr (assoc 50 ed))) (setq handle (cdr (assoc 5 ed))) (if (null rotation) (setq rotation 0.0)) (if (cdr (assoc 66 ed)) (setq attribs (csv:read-attribs ename)) (setq attribs "{}") ) (strcat " {\"block_name\":\"" (csv:json-escape blk-name) "\"" ",\"layer\":\"" (csv:json-escape layer) "\"" ",\"handle\":\"" (csv:json-escape handle) "\"" ",\"x\":" (rtos (car pt) 2 4) ",\"y\":" (rtos (cadr pt) 2 4) ",\"z\":" (rtos (if (caddr pt) (caddr pt) 0.0) 2 4) ",\"rotation\":" (rtos (* (/ rotation pi) 180.0) 2 4) ",\"attribs\":" attribs "}" ) ) ;; --- Relevante Bloecke sammeln --- ;; Filtert INSERT-Entities auf exportierbare Bloecke: ;; KR_* = Kreisel Compound-Bloecke ;; AP110* = Omniflo Geraden ;; Omniflo Boegen/Weichen = rein numerische Blocknamen (SivasNr) ;; Vario* = VarioFoerderer-Bloecke ;; Gibt Auswahlsatz zurueck oder nil. (defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname) (setq ss-all (ssget "X" (list (cons 0 "INSERT")))) (if (null ss-all) (setq ss-out nil) (progn (setq ss-out (ssadd)) (setq i 0) (while (setq ename (ssname ss-all i)) (setq ed (entget ename)) (setq bname (cdr (assoc 2 ed))) (if (or (wcmatch bname "KR_*") (wcmatch (strcase bname) "AP110*,AP_110*") (wcmatch bname "Vario*,Staustrecke*,AUS_Element*,EIN_Element*") ;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen) (wcmatch bname "#*") ) (ssadd ename ss-out) ) (setq i (1+ i)) ) (if (= (sslength ss-out) 0) (setq ss-out nil)) ) ) ss-out ) ;; --- Gemeinsame Export-Funktion --- ;; Sammelt relevante Bloecke, schreibt JSON, ruft Python auf. ;; label = Anzeigename (z.B. "EXPORTCSV") ;; py-name = Python-Skript-Name (z.B. "export_csv.py") ;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv") (defun csv:run-export (label py-name csv-name / ss i ename fh out-pfad py-skript ergebnis-pfad cmd first-block count) (princ (strcat "\n[" label "] Sammle relevante Bloecke...")) (setq ss (csv:collect-export-blocks)) (if (null ss) (progn (princ (strcat "\n[" label "] Keine relevanten Bloecke gefunden.")) (princ) ) (progn (setq count (sslength ss)) (princ (strcat "\n[" label "] " (itoa count) " Bloecke gefunden.")) ;; JSON-Datei zusammenbauen (setq out-pfad (strcat (getenv "DXFM_RESULTS") "/export_raw.json")) (setq fh (open out-pfad "w")) (if (null fh) (progn (princ (strcat "\n[" label "] FEHLER: Kann Datei nicht oeffnen: " out-pfad)) (princ) ) (progn (write-line "[" fh) (setq i 0) (setq first-block T) (while (setq ename (ssname ss i)) (if (not first-block) (write-line "," fh) ) (write-line (csv:block-to-json ename) fh) (setq first-block nil) (setq i (1+ i)) ) (write-line "]" fh) (close fh) (princ (strcat "\n[" label "] JSON geschrieben: " out-pfad)) ;; Python-Skript aufrufen (setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name)) (if (findfile py-skript) (progn (setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/" csv-name)) (setq cmd (strcat "python \"" py-skript "\"" " \"" out-pfad "\"" " \"" (getenv "DXFM_DATA") "\"" " \"" ergebnis-pfad "\"")) (princ (strcat "\n[" label "] Rufe Python auf...")) (startapp "cmd" (strcat "/c " cmd)) (princ (strcat "\n[" label "] Export gestartet: " ergebnis-pfad)) ) (princ (strcat "\n[" label "] FEHLER: Python-Skript nicht gefunden: " py-skript)) ) ) ) ) ) (princ) ) ;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen --- (defun c:EXPORTSIVAS () (csv:run-export "EXPORTSIVAS" "export_sivas.py" "export_sivas.csv") ) ;; --- EXPORTCSV: Einfache Item-Liste aller Bloecke (ohne Summierung) --- (defun c:EXPORTCSV () (csv:run-export "EXPORTCSV" "export_csv.py" "export.csv") ) ;; ============================================================ ;; TEST_FOERDERER - Automatischer Test ohne Benutzereingabe ;; Erzeugt 12 Variofoerderer (6x Auf, 6x Ab) mit deltaL=7000 ;; und verschiedenen Hoehenstufen. Tabellarische Zusammenfassung. ;; ============================================================ (defun c:TEST_FOERDERER ( / deltaL deltaH richtung ergebnis best-winkel L_GF L_VF dateiname y-offset hoehen-liste idx anz-gebaut anz-nicht-gebaut result-pfad erfolgsquote zusammenfassung-liste nr deltaH_val status winkel L_GF_val L_VF_val) ;; Bibliothek initialisieren (laedt Block-Library und extrahiert Masse) (if (not *lib-initialized*) (init-bibliothek) ) (ssg-start "TEST_FOERDERER" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA"))) (setvar "OSMODE" 0) (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) (setq deltaL 7000) (setq hoehen-liste '(0 1000 2000 3000 4000 5000)) (setq y-offset 0) (setq idx 0) (setq zusammenfassung-liste '()) (setq anz-gebaut 0) (setq anz-nicht-gebaut 0) (princ "\n") (princ "\n================================================================") (princ "\n FOERDERTEST - PRODUKTIONSPROTOKOLL") (princ "\n================================================================") (princ (strcat "\n Distanz dL = " (rtos deltaL 2 0) " mm")) (princ "\n Hoehenstufen: 0, 1000, 2000, 3000, 4000, 5000 mm") (princ "\n Richtungen: Auf + Ab") (princ "\n================================================================") (princ "\n Nr. Richtung dH (mm) Status Winkel L_GF (mm) L_VF (mm)") (princ "\n================================================================") ;; ========================================================== ;; TEIL 1: Aufwaerts-Tests (6 Foerderer) ;; ========================================================== (foreach deltaH hoehen-liste (setq idx (1+ idx)) (setq richtung "Auf") (setq ergebnis (berechne-alle-winkel deltaL deltaH richtung)) (setq best-winkel (car ergebnis)) (setq L_GF (cadr ergebnis)) (setq L_VF (caddr ergebnis)) (if (and best-winkel L_GF L_VF (> L_GF 0) (> L_VF 0)) (progn (setq anz-gebaut (1+ anz-gebaut)) (princ (strcat "\n " (itoa idx) " " (if (< idx 10) " " "") "Auf " (rtos deltaH 4 0) " " "GEBAUT " (itoa best-winkel) " Grad " (rtos L_GF 2 1) " " (rtos L_VF 2 1))) (foerderanlage-einfuegen deltaL deltaH richtung best-winkel (/ L_GF 2.0) (/ L_GF 2.0) L_VF (list 0 y-offset 0)) (setq zusammenfassung-liste (cons (list idx richtung deltaH "GEBAUT" best-winkel L_GF L_VF) zusammenfassung-liste)) ) (progn (setq anz-nicht-gebaut (1+ anz-nicht-gebaut)) (princ (strcat "\n " (itoa idx) " " (if (< idx 10) " " "") "Auf " (rtos deltaH 4 0) " " "NICHT " "--- " "--- " "---")) (cond ((and (<= L_GF 0) (<= L_VF 0)) (princ "\n -> Grund: L_GF und L_VF sind negativ (Strecke zu kurz)")) ((<= L_GF 0) (princ "\n -> Grund: L_GF ist negativ (Gefaellestrecke zu kurz)")) ((<= L_VF 0) (princ "\n -> Grund: L_VF ist negativ (keine passende Steigung moeglich)")) ((null best-winkel) (princ "\n -> Grund: Kein passender Winkel (Hoehendifferenz zu gross/klein)")) (t (princ "\n -> Grund: Unbekannter Fehler in der Berechnung")) ) (setq zusammenfassung-liste (cons (list idx richtung deltaH "NICHT_GEBAUT" nil nil nil) zusammenfassung-liste)) ) ) (setq y-offset (- y-offset 200)) ) ;; ========================================================== ;; TEIL 2: Abwaerts-Tests (6 Foerderer) ;; ========================================================== (foreach deltaH hoehen-liste (setq idx (1+ idx)) (setq richtung "Ab") (if (< deltaH 1) (progn ;; deltaH = 0 bei Abwaerts ist prinzipiell unmoeglich (setq anz-nicht-gebaut (1+ anz-nicht-gebaut)) (princ (strcat "\n " (itoa idx) " " (if (< idx 10) " " "") "Ab " (rtos deltaH 4 0) " " "NICHT " "--- " "--- " "---")) (princ "\n -> Grund: Bei Richtung 'Ab' mit dH=0 ist aus geometrischen Gruenden") (princ "\n keine Foerderanlage moeglich (immer negative Netto-Hoehe)") (setq zusammenfassung-liste (cons (list idx richtung deltaH "GEOMETRISCH_UNMOEGLICH" nil nil nil) zusammenfassung-liste)) ) (progn (setq ergebnis (berechne-alle-winkel deltaL deltaH richtung)) (setq best-winkel (car ergebnis)) (setq L_GF (cadr ergebnis)) (setq L_VF (caddr ergebnis)) (if (and best-winkel L_GF L_VF (> L_GF 0) (> L_VF 0)) (progn (setq anz-gebaut (1+ anz-gebaut)) (princ (strcat "\n " (itoa idx) " " (if (< idx 10) " " "") "Ab " (rtos deltaH 4 0) " " "GEBAUT " (itoa best-winkel) " Grad " (rtos L_GF 2 1) " " (rtos L_VF 2 1))) (foerderanlage-einfuegen deltaL deltaH richtung best-winkel (/ L_GF 2.0) (/ L_GF 2.0) L_VF (list 0 y-offset 0)) (setq zusammenfassung-liste (cons (list idx richtung deltaH "GEBAUT" best-winkel L_GF L_VF) zusammenfassung-liste)) ) (progn (setq anz-nicht-gebaut (1+ anz-nicht-gebaut)) (princ (strcat "\n " (itoa idx) " " (if (< idx 10) " " "") "Ab " (rtos deltaH 4 0) " " "NICHT " "--- " "--- " "---")) (cond ((and (<= L_GF 0) (<= L_VF 0)) (princ "\n -> Grund: L_GF und L_VF sind negativ (Strecke zu kurz)")) ((<= L_GF 0) (princ "\n -> Grund: L_GF ist negativ (Gefaellestrecke zu kurz)")) ((<= L_VF 0) (princ "\n -> Grund: L_VF ist negativ (Hoehendifferenz zu klein fuer diesen Weg)")) ((null best-winkel) (princ "\n -> Grund: Kein passender Winkel (Hoehendifferenz zu gross)")) (t (princ "\n -> Grund: Unbekannter Fehler in der Berechnung")) ) (setq zusammenfassung-liste (cons (list idx richtung deltaH "NICHT_GEBAUT" nil nil nil) zusammenfassung-liste)) ) ) ) ) (setq y-offset (- y-offset 200)) ) ;; ========================================================== ;; TEIL 3: ZUSAMMENFASSUNG ;; ========================================================== (princ "\n\n================================================================================") (princ "\n ZUSAMMENFASSUNG") (princ (strcat "\n dL = " (rtos deltaL 2 0) " mm")) (princ "\n================================================================================") (foreach item (reverse zusammenfassung-liste) (setq nr (car item)) (setq richtung (cadr item)) (setq deltaH_val (caddr item)) (setq status (cadddr item)) (setq winkel (car (cddddr item))) (setq L_GF_val (cadr (cddddr item))) (setq L_VF_val (caddr (cddddr item))) (cond ((= status "GEBAUT") (princ (strcat "\n " (itoa nr) ". " richtung (if (= richtung "Auf") " " " ") (rtos deltaH_val 2 0) " mm " (itoa winkel) " Grad " (rtos L_GF_val 2 2) " mm " (rtos L_VF_val 2 2) " mm GEBAUT"))) ((= status "GEOMETRISCH_UNMOEGLICH") (princ (strcat "\n " (itoa nr) ". " richtung (if (= richtung "Auf") " " " ") (rtos deltaH_val 2 0) " mm " "--- " "--- mm " "--- mm GEOMETRISCH UNMOEGLICH"))) (t (princ (strcat "\n " (itoa nr) ". " richtung (if (= richtung "Auf") " " " ") (rtos deltaH_val 2 0) " mm " "--- " "--- mm " "--- mm NICHT GEBAUT"))) ) ) (princ "\n\n================================================================================") (princ (strcat "\n Erfolgreich gebaut: " (itoa anz-gebaut) " von " (itoa idx))) (princ (strcat "\n Erfolgsquote: " (rtos (/ (* anz-gebaut 100.0) idx) 2 1) "%")) (princ "\n================================================================================") (princ "\n\n Erklaerung:") (princ "\n ----------") (princ "\n GEBAUT:") (princ "\n - Auf, dH=0 -> L_VF > 0 kompensiert 3 Grad-Gefaellestrecken") (princ "\n - Auf, dH>0 -> Normalfall") (princ "\n - Ab, dH>=1000 -> Normalfall") (princ "\n") (princ "\n NICHT GEBAUT:") (princ "\n - Ab, dH=0 -> Geometrisch unmoeglich (Netto-Hoehe immer negativ)") (princ "\n - Auf, dH=5000 -> 48 Grad Steigung reicht nicht aus (L_VF negativ)") (princ "\n - Ab, dH=5000 -> 48 Grad Gefaelle reicht nicht aus") (princ "\n================================================================================") (ssg-end) ;; Datei speichern (if (getenv "DXFM_RESULTS") (setq result-pfad (getenv "DXFM_RESULTS")) (setq result-pfad (strcat (getenv "DXFM_BLOCKS") "/../results")) ) (setq dateiname (strcat result-pfad "/" (menucmd "M=$(edtime,$(getvar,date),YYYYMODD-HHmm)") ".dxf")) (princ (strcat "\n\nSpeichere als: " dateiname)) (command "_.DXFOUT" dateiname "V" "2018" "16") (princ "\n\n>>> FOERDERTEST abgeschlossen (12 Foerderer)! <<<") (princ) ) ;; ============================================================ ;; TEST_KSEINAUS - KS_EIN/KS_AUS Ausrichtungstest ;; ;; Fuegt alle Vario-Bloecke in 3 Gruppen ein, jeweils 2 Reihen: ;; Gruppe 1: Stationaere Elemente (AUS, EIN, Separator, Umlenk, Motor) ;; Gruppe 2: Alle Boegen aufwaerts (in Z verschoben) ;; Gruppe 3: Alle Boegen abwaerts (in Z verschoben) ;; ;; Pro Gruppe: ;; Reihe A: nach KS_EIN ausgerichtet (KS_EIN X/Y = Referenz-X/Y) ;; Reihe B: nach KS_AUS ausgerichtet (KS_AUS X/Y = Referenz-X/Y) ;; Luecke von 400mm zwischen den Reihen ;; ============================================================ ;; Hilfsfunktion: Eine Liste von Bloecken in 2 Reihen aufreihen ;; x-start: X-Position der Gruppe ;; y-start: Y-Startposition (wird zurueckgegeben als naechster freier Y) ;; z-offset: Z-Verschiebung (fuer Boegen) ;; Rueckgabe: naechste freie Y-Position (defun ks-test-reihe (namen x-start y-start z-offset y-abstand y-luecke / bname block-obj ks-data ks-ein ks-aus insert-pt offset-vec y-pos idx) ;; --- Reihe A: nach KS_EIN --- (princ "\n Reihe KS_EIN:") (setq y-pos y-start) (setq idx 0) (foreach bname namen (setq idx (1+ idx)) (setq insert-pt (list x-start y-pos z-offset)) (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point insert-pt) bname 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))) (if ks-ein (progn (setq offset-vec (list (- x-start (car (car ks-ein))) (- y-pos (cadr (car ks-ein))) (- z-offset (caddr (car ks-ein))))) (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point offset-vec)) (princ (strcat "\n " (itoa idx) ". " bname " OK")) ) (princ (strcat "\n " (itoa idx) ". " bname " WARNUNG: KS_EIN fehlt!")) ) (setq y-pos (- y-pos y-abstand)) ) ;; --- Luecke --- (setq y-pos (- y-pos y-luecke)) ;; --- Reihe B: nach KS_AUS --- (princ "\n Reihe KS_AUS:") (setq idx 0) (foreach bname namen (setq idx (1+ idx)) (setq insert-pt (list x-start y-pos z-offset)) (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point insert-pt) bname 1.0 1.0 1.0 0)) (setq ks-data (extract-ks-from-block block-obj)) (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) (if ks-aus (progn (setq offset-vec (list (- x-start (car (car ks-aus))) (- y-pos (cadr (car ks-aus))) (- z-offset (caddr (car ks-aus))))) (vla-Move block-obj (vlax-3D-point '(0 0 0)) (vlax-3D-point offset-vec)) (princ (strcat "\n " (itoa idx) ". " bname " OK")) ) (princ (strcat "\n " (itoa idx) ". " bname " WARNUNG: KS_AUS fehlt!")) ) (setq y-pos (- y-pos y-abstand)) ) ;; Naechste freie Y-Position zurueckgeben y-pos ) (defun c:TEST_KSEINAUS ( / stationen boegen-auf-liste boegen-ab-liste bname y-pos y-abstand y-luecke z-bogen) ;; Bibliothek initialisieren (if (not *lib-initialized*) (init-bibliothek) ) (ssg-start "TEST_KSEINAUS" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA"))) (setvar "OSMODE" 0) (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) (setq y-abstand 200) (setq y-luecke 400) (setq z-bogen 2500) ;; Gruppe 1: Stationaere Elemente (setq stationen (list "_3D_AS_90_links" "Staustrecke_Separator_SP_300_mm" "Vario_Umlenkstation_500mm" "Vario_Motorstation_500mm" "_3D_ES_90_links" )) ;; Gruppe 2+3: Boegen sammeln (setq boegen-auf-liste '()) (setq boegen-ab-liste '()) (foreach w '(3 6 9 12 15 18 21 27 33 39 45 51) (setq bname (strcat "Vario_Bogen_auf_" (itoa w) grad-zeichen)) (if (tblsearch "BLOCK" bname) (setq boegen-auf-liste (append boegen-auf-liste (list bname))) ) (setq bname (strcat "Vario_Bogen_ab_" (itoa w) grad-zeichen)) (if (tblsearch "BLOCK" bname) (setq boegen-ab-liste (append boegen-ab-liste (list bname))) ) ) (princ "\n================================================================") (princ "\n TEST_KSEINAUS - KS-Ausrichtungstest") (princ (strcat "\n Stationen: " (itoa (length stationen)))) (princ (strcat "\n Boegen auf: " (itoa (length boegen-auf-liste)))) (princ (strcat "\n Boegen ab: " (itoa (length boegen-ab-liste)))) (princ (strcat "\n Z-Offset Boegen: " (rtos z-bogen 2 0) " mm")) (princ "\n================================================================") ;; Gruppe 1: Stationaere Elemente bei X=0, Z=0 (princ "\n\n GRUPPE 1: Stationaere Elemente (Z=0)") (setq y-pos (ks-test-reihe stationen 0 0 0 y-abstand y-luecke)) ;; Gruppe 2: Boegen aufwaerts bei X=3000, Z=z-bogen (princ "\n\n GRUPPE 2: Boegen aufwaerts (Z=" ) (princ (strcat (rtos z-bogen 2 0) ")")) (setq y-pos (ks-test-reihe boegen-auf-liste 3000 0 z-bogen y-abstand y-luecke)) ;; Gruppe 3: Boegen abwaerts bei X=6000, Z=z-bogen (princ "\n\n GRUPPE 3: Boegen abwaerts (Z=") (princ (strcat (rtos z-bogen 2 0) ")")) (setq y-pos (ks-test-reihe boegen-ab-liste 6000 0 z-bogen y-abstand y-luecke)) (ssg-end) (princ "\n\n================================================================") (princ "\n TEST_KSEINAUS abgeschlossen") (princ "\n X=0: Stationen (KS_EIN + KS_AUS)") (princ "\n X=3000: Boegen auf (KS_EIN + KS_AUS)") (princ "\n X=6000: Boegen ab (KS_EIN + KS_AUS)") (princ "\n================================================================") (princ) )