Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
1f7aeb420dea2ed839ea417037f6949650e0ae5a
dxfmakros/tests/test_kreisel.lsp
T
m.stangl c01dad28f3 Testroutinen auf kseinaus umbenannt und aktualisiert 
test_ks.lsp in test_kseinaus.lsp umbenannt und alle Testroutinen
(foerderer, kreisel, omniflo) sowie run_tests.bat und README
entsprechend angepasst.
2026-06-19 21:00:45 +02:00

258 lines
8.7 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; test_kreisel.lsp - Automatischer Integrationstest fuer Kreisel
;;
;; Laedt Testfaelle aus tests/testdata/kreisel_tests.json,
;; fuegt Kreisel per insert und connect ein, sammelt
;; Ergebnisse und speichert:
;; - tests/output/kreisel_tests.dxf (Zeichnung mit Bloecken)
;; - tests/output/kreisel_results.json (Attribut-/Positions-Daten)
;;
;; Voraussetzungen:
;; - SSG_LIB geladen (KreiselInsert.lsp, ssg_core.lsp)
;; - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Aufruf in BricsCAD:
;; (load "tests/test_kreisel.lsp")
;; TEST_KREISEL
;; ============================================================
;; --- Ergebnis eines Testfalls als JSON-String erzeugen ---
(defun kreisel:test-result-json (test-id status block-name block-handle
insert-point attribs /
json att-json tag val first)
(setq json (strcat " {\n"
" \"test_id\": \"" test-id "\",\n"
" \"status\": \"" status "\",\n"
" \"block_name\": \"" (if block-name block-name "") "\",\n"
" \"block_handle\": \"" (if block-handle block-handle "") "\",\n"
" \"insert_point\": ["
(if insert-point
(strcat (rtos (car insert-point) 2 1) ", "
(rtos (cadr insert-point) 2 1) ", "
(rtos (if (caddr insert-point) (caddr insert-point) 0.0) 2 1))
"0.0, 0.0, 0.0"
)
"],\n"
" \"actual_attributes\": {"))
;; Attribute als JSON
(setq first T)
(foreach att attribs
(setq tag (car att))
(setq val (cdr att))
(if (not first) (setq json (strcat json ",")))
(setq json (strcat json "\n \"" tag "\": \"" (if val val "") "\""))
(setq first nil)
)
(setq json (strcat json "\n }\n }"))
json
)
;; --- Einzelnen Insert-Testfall ausfuehren ---
(defun kreisel:run-insert-test (eintrag / id x y z abstand rotation typ
pt blockEnt ed attribs block-name
block-handle insert-point)
(setq id (omni:val eintrag "id"))
(setq x (omni:val eintrag "x"))
(setq y (omni:val eintrag "y"))
(setq z (omni:val eintrag "z"))
(setq abstand (omni:val eintrag "abstand"))
(setq rotation (omni:val eintrag "rotation"))
(setq typ (omni:val eintrag "typ"))
(if (numberp x) (setq x (float x)))
(if (numberp y) (setq y (float y)))
(if (numberp z) (setq z (float z)))
(if (numberp abstand) (setq abstand (float abstand)))
(if (numberp rotation) (setq rotation (float rotation)))
(setq pt (list x y z))
(princ (strcat "\n [INSERT] " id " -> (" (rtos x 2 0) ", " (rtos y 2 0)
", " (rtos z 2 0) ") A=" (rtos abstand 2 0)
" R=" (rtos rotation 2 1) " " typ))
(setq blockEnt (kreisel-insert-script pt abstand rotation typ z))
(if blockEnt
(progn
(setq ed (entget blockEnt))
(setq block-name (cdr (assoc 2 ed)))
(setq block-handle (cdr (assoc 5 ed)))
(setq insert-point (cdr (assoc 10 ed)))
(setq attribs (ssg-attrib-read blockEnt))
(princ (strcat " OK: " block-name))
(kreisel:test-result-json id "executed" block-name block-handle
insert-point attribs)
)
(progn
(princ (strcat " FEHLER: " id))
(kreisel:test-result-json id "failed" nil nil nil nil)
)
)
)
;; --- Einzelnen Connect-Testfall ausfuehren ---
(defun kreisel:run-connect-test (eintrag / id sx sy sz ex ey ez typ
ptStart ptEnd blockEnt ed attribs
block-name block-handle insert-point)
(setq id (omni:val eintrag "id"))
(setq sx (omni:val eintrag "start_x"))
(setq sy (omni:val eintrag "start_y"))
(setq sz (omni:val eintrag "start_z"))
(setq ex (omni:val eintrag "end_x"))
(setq ey (omni:val eintrag "end_y"))
(setq ez (omni:val eintrag "end_z"))
(setq typ (omni:val eintrag "typ"))
(if (numberp sx) (setq sx (float sx)))
(if (numberp sy) (setq sy (float sy)))
(if (numberp sz) (setq sz (float sz)))
(if (numberp ex) (setq ex (float ex)))
(if (numberp ey) (setq ey (float ey)))
(if (numberp ez) (setq ez (float ez)))
(setq ptStart (list sx sy sz))
(setq ptEnd (list ex ey ez))
(princ (strcat "\n [CONNECT] " id
" -> (" (rtos sx 2 0) "," (rtos sy 2 0)
") -> (" (rtos ex 2 0) "," (rtos ey 2 0) ") " typ))
(setq blockEnt (kreisel-connect-script ptStart ptEnd typ sz))
(if blockEnt
(progn
(setq ed (entget blockEnt))
(setq block-name (cdr (assoc 2 ed)))
(setq block-handle (cdr (assoc 5 ed)))
(setq insert-point (cdr (assoc 10 ed)))
(setq attribs (ssg-attrib-read blockEnt))
(princ (strcat " OK: " block-name))
(kreisel:test-result-json id "executed" block-name block-handle
insert-point attribs)
)
(progn
(princ (strcat " FEHLER: " id))
(kreisel:test-result-json id "failed" nil nil nil nil)
)
)
)
;; --- JSON-Export der Kreisel-Testergebnisse ---
(defun kreisel:export-results (tests-out-dir / out-json f first)
(if (null *kreisel-test-results*)
(princ "\n Keine Kreisel-Ergebnisse vorhanden.")
(progn
(vl-mkdir tests-out-dir)
(setq out-json (strcat tests-out-dir "/kreisel_results.json"))
(setq f (open out-json "w"))
(if f
(progn
(write-line "[" f)
(setq first T)
(foreach r *kreisel-test-results*
(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!"))
)
)
)
)
;; ============================================================
;; C:TEST_KREISEL - Hauptbefehl
;; ============================================================
(defun c:TEST_KREISEL (/ tests-json-pfad testfaelle
eintrag func
result-json results-list
anzahl-ok anzahl-fehler)
(ssg-start "TEST_KREISEL" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; Testdaten laden
(setq tests-json-pfad
(strcat (getenv "DXFMAKRO") "/tests/testdata/kreisel_tests.json"))
(if (not (findfile tests-json-pfad))
(progn
(princ (strcat "\n[TEST_KREISEL] FEHLER: " tests-json-pfad " nicht gefunden!"))
(ssg-end)
(princ)
)
(progn
(setq testfaelle (omni:load-json tests-json-pfad))
(if (null testfaelle)
(progn
(princ "\n[TEST_KREISEL] FEHLER: Testdaten konnten nicht geladen werden.")
(ssg-end)
(princ)
)
(progn
(princ "\n================================================================")
(princ "\n TEST_KREISEL")
(princ (strcat "\n " (itoa (length testfaelle)) " Testfaelle geladen"))
(princ "\n================================================================")
(setq results-list nil)
(setq anzahl-ok 0)
(setq anzahl-fehler 0)
;; Testfaelle ausfuehren
(foreach eintrag testfaelle
(setq func (omni:val eintrag "function"))
(setq result-json
(cond
((= func "insert")
(kreisel:run-insert-test eintrag))
((= func "connect")
(kreisel:run-connect-test eintrag))
(T
(princ (strcat "\n WARNUNG: Unbekannte Funktion: " func))
nil)
)
)
(if result-json
(progn
(setq results-list (cons result-json results-list))
(if (vl-string-search "executed" result-json)
(setq anzahl-ok (1+ anzahl-ok))
(setq anzahl-fehler (1+ anzahl-fehler))
)
)
)
)
;; Zusammenfassung
(princ "\n================================================================")
(princ (strcat "\n Ergebnis: " (itoa anzahl-ok) " OK, "
(itoa anzahl-fehler) " Fehler"))
(princ "\n================================================================")
;; Ergebnisse in globaler Variable speichern
(setq *kreisel-test-results* (reverse results-list))
(ssg-end)
(princ "\n================================================================")
(princ "\n TEST_KREISEL abgeschlossen.")
(princ "\n================================================================")
(princ)
)
)
)
)
)
Reference in New Issue View Git Blame Copy Permalink