Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
bd053d76d3e090a5bceedefc38470e438ae8c29a
dxfmakros/tests/test_ks.lsp
T

263 lines
8.9 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; test_ks.lsp - Automatischer Integrationstest fuer KS_EIN/KS_AUS
;;
;; 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
;; Reihe B: nach KS_AUS ausgerichtet
;; Luecke von 400mm zwischen den Reihen
;;
;; Speichert:
;; - tests/output/ks_results.json (Ergebnisse)
;; - tests/output/ks_tests.dxf (Zeichnung)
;;
;; Voraussetzungen:
;; - SSG_LIB geladen (VarioFoerderer.lsp, ssg_core.lsp)
;; - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_ks.lsp"))
;; TEST_KSEINAUS
;; ============================================================
;; --- Ergebnis eines Testfalls als JSON-String erzeugen ---
(defun ks:test-result-json (test-id block-name gruppe ks-type status /
json)
(setq json (strcat " {\n"
" \"test_id\": \"" test-id "\",\n"
" \"block_name\": \"" (if block-name block-name "") "\",\n"
" \"gruppe\": \"" gruppe "\",\n"
" \"ks_type\": \"" ks-type "\",\n"
" \"status\": \"" status "\"\n"
" }"))
json
)
;; --- Eine Reihe Bloecke einfuegen und Ergebnisse sammeln ---
;; Rueckgabe: (naechste-y-pos . results-list)
(defun ks:test-reihe (namen x-start y-start z-offset y-abstand y-luecke
gruppe results-in /
bname block-obj ks-data ks-ein ks-aus
insert-pt offset-vec y-pos idx
test-id results-out)
(setq results-out results-in)
;; --- 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 test-id (strcat gruppe "_KS_EIN_" (itoa 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"))
(setq results-out (cons
(ks:test-result-json test-id bname gruppe "KS_EIN" "OK")
results-out))
)
(progn
(princ (strcat "\n " (itoa idx) ". " bname " WARNUNG: KS_EIN fehlt!"))
(setq results-out (cons
(ks:test-result-json test-id bname gruppe "KS_EIN" "KS_FEHLT")
results-out))
)
)
(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 test-id (strcat gruppe "_KS_AUS_" (itoa 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"))
(setq results-out (cons
(ks:test-result-json test-id bname gruppe "KS_AUS" "OK")
results-out))
)
(progn
(princ (strcat "\n " (itoa idx) ". " bname " WARNUNG: KS_AUS fehlt!"))
(setq results-out (cons
(ks:test-result-json test-id bname gruppe "KS_AUS" "KS_FEHLT")
results-out))
)
)
(setq y-pos (- y-pos y-abstand))
)
;; Rueckgabe: (naechste-y-pos . results-list)
(cons y-pos results-out)
)
;; ============================================================
;; C:TEST_KSEINAUS - Hauptbefehl
;; ============================================================
(defun c:TEST_KSEINAUS ( / stationen boegen-auf-liste boegen-ab-liste
bname y-pos y-abstand y-luecke z-bogen
results-list reihe-result
anz-ok anz-fehlt
tests-out-dir out-json out-dxf f first)
;; 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)
(setq results-list '())
;; 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 reihe-result (ks:test-reihe stationen 0 0 0 y-abstand y-luecke
"Stationen" results-list))
(setq y-pos (car reihe-result))
(setq results-list (cdr reihe-result))
;; Gruppe 2: Boegen aufwaerts bei X=3000, Z=z-bogen
(princ (strcat "\n\n GRUPPE 2: Boegen aufwaerts (Z=" (rtos z-bogen 2 0) ")"))
(setq reihe-result (ks:test-reihe boegen-auf-liste 3000 0 z-bogen y-abstand y-luecke
"Boegen_Auf" results-list))
(setq y-pos (car reihe-result))
(setq results-list (cdr reihe-result))
;; Gruppe 3: Boegen abwaerts bei X=6000, Z=z-bogen
(princ (strcat "\n\n GRUPPE 3: Boegen abwaerts (Z=" (rtos z-bogen 2 0) ")"))
(setq reihe-result (ks:test-reihe boegen-ab-liste 6000 0 z-bogen y-abstand y-luecke
"Boegen_Ab" results-list))
(setq y-pos (car reihe-result))
(setq results-list (cdr reihe-result))
;; Zusammenfassung
(setq anz-ok 0)
(setq anz-fehlt 0)
(foreach r results-list
(if (vl-string-search "\"OK\"" r)
(setq anz-ok (1+ anz-ok))
(setq anz-fehlt (1+ anz-fehlt))
)
)
(princ "\n================================================================")
(princ (strcat "\n Ergebnis: " (itoa anz-ok) " OK, "
(itoa anz-fehlt) " KS fehlt"))
(princ "\n================================================================")
;; ==========================================================
;; Ergebnisse speichern
;; ==========================================================
(setq tests-out-dir (strcat (getenv "DXFMAKRO") "/tests/output"))
(vl-mkdir tests-out-dir)
;; JSON schreiben
(setq out-json (strcat tests-out-dir "/ks_results.json"))
(setq f (open out-json "w"))
(if f
(progn
(write-line "[" f)
(setq results-list (reverse results-list))
(setq first T)
(foreach r results-list
(if (not first) (write-line "," f))
(write-line r f)
(setq first nil)
)
(write-line "]" f)
(close f)
(princ (strcat "\n Ergebnisse: " out-json))
)
(princ (strcat "\n FEHLER: Kann " out-json " nicht schreiben!"))
)
;; DXF speichern
(setq out-dxf (strcat tests-out-dir "/ks_tests.dxf"))
(command "_.SAVEAS" "DXF" out-dxf)
(princ (strcat "\n DXF gespeichert: " out-dxf))
(ssg-end)
(princ "\n================================================================")
(princ "\n TEST_KSEINAUS abgeschlossen.")
(princ "\n================================================================")
(princ)
)
Reference in New Issue View Git Blame Copy Permalink