;; ============================================================ ;; 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) )