483 lines
18 KiB
Common Lisp
483 lines
18 KiB
Common Lisp
;; ============================================================
|
|
;; 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)
|
|
)
|