Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f8b8a4175bc854bbbcceadb5880643fbfe7ab43b
dxfmakros/tests/test_unit.lsp
T
y.wang f8b8a4175b fix: KF_EDIT baute gedrehte Foerderer ungedreht neu 
Der Drehwinkel wird beim Bau in die Geometrie eingerechnet, die Blockreferenz
selbst hat immer Drehung 0 (ssg-block-wrap-welt). KF_EDIT las die Drehung nur
aus Gruppencode 50 und baute einen mit z.B. 90 Grad gebauten Foerderer beim
Bearbeiten daher ungedreht neu.

Der gebaute Winkel steht jetzt als XDATA (SSG_KF_EDIT) am Block. KF_EDIT
addiert eine spaeter von Hand vorgenommene Drehung der Referenz
(Gruppencode 50); Altbestand ohne XDATA verhaelt sich wie bisher.

- kf-block-erstellen: neuer Parameter drehung, beide Aufrufer angepasst
- reiner Kern kf-drehung-gesamt (auf -180..180 normalisiert) mit Unit-Tests

Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com>
2026-10-23 15:43:36 +02:00

2809 lines
150 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; test_unit.lsp - Unit-Tests fuer einfache LISP-Standardfunktionen
;;
;; Testet reine Hilfsfunktionen (String, Zahl, Vektor, Liste,
;; Alist), die OHNE Zeichnungsdatenbank, Auswahlsaetze, Dialoge
;; oder Blockdateien auskommen - analog zu den Python-Unittests,
;; nur direkt in AutoLISP formuliert. Jeder Testfall vergleicht
;; einen Funktionsaufruf gegen ein erwartetes Ergebnis.
;;
;; Aufruf in BricsCAD (SSG_LIB muss geladen sein):
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp"))
;; TEST_UNIT
;;
;; Ueber die Kommandozeile:
;; bin\run_tests.bat --lisp
;; (startet BricsCAD mit tests/output/_unit_run.scr, laedt SSG_LIB,
;; fuehrt TEST_UNIT aus und schreibt tests/output/unit_results.txt)
;;
;; Ergebnis:
;; Konsole: PASS/FAIL je Test + Zusammenfassung
;; Datei: tests/output/unit_results.txt (von run_tests.bat gelesen)
;;
;; Ladearchitektur (EINHEITLICH):
;; Das Laden der zu testenden Module passiert AUSSCHLIESSLICH auf .scr-
;; Top-Level in tests/test_unit.scr - die Core-Module ueber ssg_load.lsp,
;; die lazy Feature-Module (GeruestInsert, count_sep_scan) per explizitem
;; load. Die Testbloecke hier laden NICHTS nach; sie pruefen nur per
;; atoms-family, ob ihr Modul vorhanden ist, und ueberspringen sich sonst
;; mit einer FAIL-Meldung.
;; Grund: In BricsCAD werden per load definierte Funktionen erst nach
;; Rueckkehr zum Top-Level sichtbar. Ein load INNERHALB von c:TEST_UNIT
;; oder eines per vl-catch-all-apply gecatchten Testblocks bindet die
;; frisch definierten Funktionen im laufenden Durchlauf NICHT (beobachtet:
;; geruest-id-string/cs-in-box blieben ungebunden). Darum gehoert alles
;; Laden vor den (c:TEST_UNIT)-Aufruf ins .scr.
;; ============================================================
;; ------------------------------------------------------------
;; MINI-TEST-FRAMEWORK
;; ------------------------------------------------------------
(setq *tu-results* nil) ;; Liste von (pass-p name detail)
(setq *tu-pass* 0)
(setq *tu-fail* 0)
(defun tu-reset ()
(setq *tu-results* nil *tu-pass* 0 *tu-fail* 0)
)
(defun tu-str (v) (vl-princ-to-string v))
;; Ergebnis eines Testfalls erfassen
(defun tu-record (pass-p name detail)
(if pass-p
(setq *tu-pass* (1+ *tu-pass*))
(setq *tu-fail* (1+ *tu-fail*))
)
(setq *tu-results* (cons (list pass-p name detail) *tu-results*))
(princ (strcat "\n " (if pass-p "PASS" "FAIL") ": " name))
(if (not pass-p) (princ (strcat " | " detail)))
pass-p
)
;; Exakter Vergleich (Strings, Ganzzahlen, Listen von Strings/Ints)
(defun tu-eq (name expected actual)
(tu-record (equal expected actual) name
(strcat "erwartet=" (tu-str expected) " tatsaechlich=" (tu-str actual)))
)
;; Numerischer Vergleich mit Toleranz (Fliesskomma, auch verschachtelte Listen)
(defun tu-eqf (name expected actual)
(tu-record (equal expected actual 1e-6) name
(strcat "erwartet=" (tu-str expected) " tatsaechlich=" (tu-str actual)))
)
(defun tu-true (name actual)
(tu-record (not (null actual)) name (strcat "tatsaechlich=" (tu-str actual)))
)
(defun tu-nil (name actual)
(tu-record (null actual) name (strcat "tatsaechlich=" (tu-str actual)))
)
;; ------------------------------------------------------------
;; TESTS: ssg_core.lsp - String-/JSON-/Alist-Helfer
;; ------------------------------------------------------------
(defun tu-tests-core ()
(princ "\n[ssg_core]")
;; ssg-cfg-trim: Whitespace + abschliessendes Komma entfernen
(tu-eq "ssg-cfg-trim/spaces+komma" "hello" (ssg-cfg-trim " hello, "))
(tu-eq "ssg-cfg-trim/nur-spaces" "abc" (ssg-cfg-trim "\tabc\r\n"))
;; ssg-cfg-parse-value: JSON-Skalar erkennen
(tu-eq "ssg-cfg-parse-value/string" "text" (ssg-cfg-parse-value "\"text\""))
(tu-eq "ssg-cfg-parse-value/int" 42 (ssg-cfg-parse-value "42"))
(tu-eqf "ssg-cfg-parse-value/real" 3.5 (ssg-cfg-parse-value "3.5"))
(tu-true "ssg-cfg-parse-value/true" (ssg-cfg-parse-value "true"))
(tu-nil "ssg-cfg-parse-value/false" (ssg-cfg-parse-value "false"))
(tu-nil "ssg-cfg-parse-value/null" (ssg-cfg-parse-value "null"))
;; ssg-cfg-split-comma: an Kommas aufteilen
(tu-eq "ssg-cfg-split-comma" '("a" "b" "c") (ssg-cfg-split-comma "a,b,c"))
;; ssg-cfg-parse-array: JSON-Array parsen
(tu-eq "ssg-cfg-parse-array" '(1 2 3) (ssg-cfg-parse-array "[1, 2, 3]"))
;; ssg-cfg-parse-kv: "key": wert -> ("key" . wert)
(tu-eq "ssg-cfg-parse-kv" '("key" . 42) (ssg-cfg-parse-kv "\"key\": 42"))
;; ssg-val: Wert aus Alist lesen
(tu-eq "ssg-val/vorhanden" 2 (ssg-val '(("a" . 1) ("b" . 2)) "b"))
(tu-nil "ssg-val/fehlt" (ssg-val '(("a" . 1)) "x"))
;; ssg-attrib-defaults: (TAG DEFAULT) -> (TAG . DEFAULT)
(tu-eq "ssg-attrib-defaults"
'(("TYP" . "A") ("NR" . "0"))
(ssg-attrib-defaults '(("TYP" "A") ("NR" "0"))))
;; ssg-attrib-merge: gegebene Werte ueberschreiben Defaults
(tu-eq "ssg-attrib-merge/override"
'(("TYP" . "A") ("NR" . "5"))
(ssg-attrib-merge '(("NR" . "5")) '(("TYP" "A") ("NR" "0"))))
(tu-eq "ssg-attrib-merge/nil-given"
'(("TYP" . "A") ("NR" . "0"))
(ssg-attrib-merge nil '(("TYP" "A") ("NR" "0"))))
;; ssg-attrib-alist-to-defs: (TAG . Wert) -> (TAG Wert)
(tu-eq "ssg-attrib-alist-to-defs"
'(("TYP" "A") ("NR" "0"))
(ssg-attrib-alist-to-defs '(("TYP" . "A") ("NR" . "0"))))
;; ssg-geruest-typ-to-idx / idx-to-typ (Combobox-Zuordnung)
(tu-eq "ssg-geruest-typ-to-idx/bekannt" 2 (ssg-geruest-typ-to-idx "Schoenenberger Geruest"))
(tu-eq "ssg-geruest-typ-to-idx/erst" 0 (ssg-geruest-typ-to-idx "IPE-Geruest abgestuft"))
(tu-eq "ssg-geruest-typ-to-idx/unbekannt" 2 (ssg-geruest-typ-to-idx "gibtsnicht"))
(tu-eq "ssg-geruest-idx-to-typ" "Schoenenberger Geruest" (ssg-geruest-idx-to-typ 2))
;; ssg-ini-* : INI-Parser (Eingabe = Zeilenliste, kein Datei-IO)
(setq _ini (ssg-ini-parse-lines
'("# Kommentar" "[sek]" "key = wert" "liste = a, b ,c")))
(tu-eq "ssg-ini-get/vorhanden" "wert" (ssg-ini-get _ini "sek" "key" "def"))
(tu-eq "ssg-ini-get/default" "def" (ssg-ini-get _ini "sek" "fehlt" "def"))
(tu-eq "ssg-ini-list/normalisiert" "a,b,c" (ssg-ini-list _ini "sek" "liste" "x"))
;; ssg-parse-json-array: flaches JSON-Array -> Liste von Alists
(tu-eq "ssg-parse-json-array"
'((("a" . 1) ("b" . 2)))
(ssg-parse-json-array '("[" "{" "\"a\": 1," "\"b\": 2" "}" "]")))
;; ssg-layer-cfg-eintrag: "Layername, Farbe" -> (layer . farbe)
;; Reine Funktion, ini-Daten als Parameter - kein Datei-IO, keine Zeichnung.
(setq _lay (ssg-ini-parse-lines
'("# Kommentar"
"[ils_2d]"
"variofoerderer = ILS_Fingerfoerderer, 4"
"ohne_farbe = ILS_SP"
"leer ="
"[ils_3d]"
"variofoerderer = _3D_ILS_Fingerfoerderer, 4"
"[allgemein]"
"vf_beschriftung = VF_Beschriftung, 7")))
(tu-eq "ssg-layer-cfg-eintrag/layer-und-farbe"
'("ILS_Fingerfoerderer" . "4")
(ssg-layer-cfg-eintrag _lay "ils_2d" "variofoerderer"))
(tu-eq "ssg-layer-cfg-eintrag/ohne-farbe-default-7"
'("ILS_SP" . "7")
(ssg-layer-cfg-eintrag _lay "ils_2d" "ohne_farbe"))
(tu-nil "ssg-layer-cfg-eintrag/leerer-wert"
(ssg-layer-cfg-eintrag _lay "ils_2d" "leer"))
(tu-nil "ssg-layer-cfg-eintrag/key-fehlt"
(ssg-layer-cfg-eintrag _lay "ils_2d" "gibtsnicht"))
(tu-nil "ssg-layer-cfg-eintrag/sektion-fehlt"
(ssg-layer-cfg-eintrag _lay "gibtsnicht" "variofoerderer"))
;; ssg-layer-eintrag: Aufloesung [ils_<dim>] -> [allgemein].
;; Dimension und cfg werden hier injiziert (kein Datei-IO); der gemerkte
;; Ladeversuch verhindert, dass ssg-layer-cfg-load die echte Datei liest.
(setq _lay-cfg-alt *ssg-layer-cfg*
_lay-vers-alt *ssg-layer-cfg-versucht*
_lay-dim-alt (if (boundp '*ssg-ils-dim*) *ssg-ils-dim*))
(setq *ssg-layer-cfg* _lay *ssg-layer-cfg-versucht* T)
(setq *ssg-ils-dim* "2D")
(tu-eq "ssg-layer-eintrag/dim-2d"
'("ILS_Fingerfoerderer" . "4") (ssg-layer-eintrag "variofoerderer"))
(tu-eq "ssg-layer-eintrag/fallback-allgemein"
'("VF_Beschriftung" . "7") (ssg-layer-eintrag "vf_beschriftung"))
(setq *ssg-ils-dim* "3D")
(tu-eq "ssg-layer-eintrag/dim-3d"
'("_3D_ILS_Fingerfoerderer" . "4") (ssg-layer-eintrag "variofoerderer"))
(tu-nil "ssg-layer-eintrag/unbekannte-baugruppe"
(ssg-layer-eintrag "gibtsnicht"))
;; ssg-layer-farbe-fuer-name: Farbe zu einem LAYERNAMEN (nicht Baugruppe).
;; Wird gebraucht, weil Layer aus dem LAYER-Attribut oft VOR dem Wrapper
;; angelegt werden und ssg-make-layer die Farbe nur bei Neuanlage setzt.
(setq *ssg-layer-cfg* (ssg-ini-parse-lines
'("[ils_3d]"
"gefaellestrecke = _3D_ILS_SP, 3"
"[allgemein]"
"vf_beschriftung = VF_Beschriftung, 7"
"[farben]"
"ILS_SEP-SP = 82")))
(tu-eq "ssg-layer-farbe-fuer-name/abschnitt-farben"
"82" (ssg-layer-farbe-fuer-name "ILS_SEP-SP"))
(tu-eq "ssg-layer-farbe-fuer-name/aus-baugruppen-wert"
"3" (ssg-layer-farbe-fuer-name "_3D_ILS_SP"))
(tu-eq "ssg-layer-farbe-fuer-name/case-insensitiv"
"3" (ssg-layer-farbe-fuer-name "_3d_ils_sp"))
(tu-eq "ssg-layer-farbe-fuer-name/unbekannt-default-7"
"7" (ssg-layer-farbe-fuer-name "GibtsNicht"))
(tu-eq "ssg-layer-farbe-fuer-name/leerer-name"
"7" (ssg-layer-farbe-fuer-name ""))
;; Globale Zustaende wieder herstellen
(setq *ssg-ils-dim* _lay-dim-alt
*ssg-layer-cfg* _lay-cfg-alt
*ssg-layer-cfg-versucht* _lay-vers-alt)
;; --- DCL-Vorlagen: Platzhalterzeilen //@NAME@ ersetzen ---
(tu-eq "ssg-dcl-zeilen-ersetzen/ersetzt"
'("a {" " x;" " y;" "}")
(ssg-dcl-zeilen-ersetzen '("a {" " //@L@" "}") '(("L" " x;" " y;"))))
(tu-eq "ssg-dcl-zeilen-ersetzen/leer-entfernt"
'("a {" "}")
(ssg-dcl-zeilen-ersetzen '("a {" "\t//@L@ " "}") '(("L"))))
(tu-eq "ssg-dcl-zeilen-ersetzen/mehrere"
'("1" "2")
(ssg-dcl-zeilen-ersetzen '("//@A@" "//@B@") '(("A" "1") ("B" "2"))))
;; unbekannter Marker und normaler Kommentar bleiben stehen
(tu-eq "ssg-dcl-zeilen-ersetzen/unbekannt"
'("//@X@" "// Kommentar")
(ssg-dcl-zeilen-ersetzen '("//@X@" "// Kommentar") '(("A" "1"))))
)
;; ------------------------------------------------------------
;; TESTS: ssg_lang.lsp - Textersetzung
;; ------------------------------------------------------------
(defun tu-tests-lang ()
(princ "\n[ssg_lang]")
;; ssg-str-replace-all: (neu alt str)
(tu-eq "ssg-str-replace-all/alle" "fXX" (ssg-str-replace-all "X" "o" "foo"))
(tu-eq "ssg-str-replace-all/mehrfach" "a-b-c" (ssg-str-replace-all "-" "." "a.b.c"))
(tu-eq "ssg-str-replace-all/keins" "abc" (ssg-str-replace-all "X" "z" "abc"))
;; ssg-lang-unescape: literales \n (Backslash+n) -> echter Zeilenumbruch
(setq _u (ssg-lang-unescape (strcat "a" "\\n" "b")))
(tu-eq "ssg-lang-unescape/laenge" 3 (strlen _u))
(tu-eq "ssg-lang-unescape/newline" (chr 10) (substr _u 2 1))
)
;; ------------------------------------------------------------
;; TESTS: ssg_id.lsp - ID-Formatierung
;; ------------------------------------------------------------
(defun tu-tests-id ()
(princ "\n[ssg_id]")
(tu-eq "ssg-id-format/1" "0001" (ssg-id-format 1))
(tu-eq "ssg-id-format/42" "0042" (ssg-id-format 42))
(tu-eq "ssg-id-format/1000" "1000" (ssg-id-format 1000))
(tu-eq "ssg-id-format/12345" "12345" (ssg-id-format 12345))
;; Reservierte IDs (XDATA SSG_ID_RES): Serialisierung + Maximum.
(setq _rp '(("AS|1" . "0032") ("ES|4" . "0107")))
(tu-eq "ssg-id-res->strings" '("AS|1=0032" "ES|4=0107") (ssg-id-res->strings _rp))
(tu-eq "ssg-id-res-parse/rundlauf" _rp (ssg-id-res-parse (ssg-id-res->strings _rp)))
(tu-eq "ssg-id-res-parse/ohne-gleich-ignoriert" '(("AS|1" . "0032"))
(ssg-id-res-parse '("kaputt" "AS|1=0032")))
(tu-eq "ssg-id-res-parse/leerer-wert" '(("AS|1" . "")) (ssg-id-res-parse '("AS|1=")))
(tu-eq "ssg-id-res-max" 107 (ssg-id-res-max _rp))
(tu-eq "ssg-id-res-max/leer" 0 (ssg-id-res-max nil))
)
;; ------------------------------------------------------------
;; TESTS: vf_core.lsp - Vektor-/Frame-Mathematik
;; ------------------------------------------------------------
(defun tu-tests-vfcore ()
(princ "\n[vf_core]")
(tu-eqf "vec-length/3-4-0" 5.0 (vec-length '(3.0 4.0 0.0)))
(tu-eqf "vec3-cross/x-cross-y" '(0.0 0.0 1.0) (vec3-cross '(1.0 0.0 0.0) '(0.0 1.0 0.0)))
(tu-eqf "vec3-cross/z-cross-x" '(0.0 1.0 0.0) (vec3-cross '(0.0 0.0 1.0) '(1.0 0.0 0.0)))
(tu-eqf "vec3-normalize/z5" '(0.0 0.0 1.0) (vec3-normalize '(0.0 0.0 5.0)))
(tu-eqf "mat3-mul-vec3/identitaet"
'(2.0 3.0 4.0)
(mat3-mul-vec3 '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) '(2.0 3.0 4.0)))
(tu-eqf "punkt-differenz" '(3.0 4.0 5.0) (punkt-differenz '(1.0 1.0 1.0) '(4.0 5.0 6.0)))
(tu-eq "ks-normalize-name/ksys-ein" "KS_EIN" (ks-normalize-name "KSYS_EIN"))
(tu-eq "ks-normalize-name/ks-aus" "KS_AUS" (ks-normalize-name "KS_AUS"))
(tu-nil "ks-normalize-name/kein-ks" (ks-normalize-name "IRGENDWAS"))
(tu-eq "ks-line-axis/X-1" "X" (ks-line-axis 1.0))
(tu-eq "ks-line-axis/X-100" "X" (ks-line-axis 100.0))
(tu-eq "ks-line-axis/Y" "Y" (ks-line-axis 2.0))
(tu-eq "ks-line-axis/Z" "Z" (ks-line-axis 3.0))
(tu-eq "fmt/zahl" "3.14" (fmt 3.14159))
(tu-eq "fmt/nil" "---" (fmt nil))
;; hz-winkel->xu: Richtungsvektor aus Horizontal-/Vertikalwinkel
(tu-eqf "hz-winkel->xu/0-0" '(1.0 0.0 0.0) (hz-winkel->xu 0 0))
(tu-eqf "hz-winkel->xu/90-0" '(0.0 1.0 0.0) (hz-winkel->xu 90 0))
;; Roundtrip frame -> (hz winkel)
(tu-eqf "frame->hz-winkel/roundtrip"
'(30.0 10.0)
(frame->hz-winkel (punkt-hz-winkel->frame '(0.0 0.0 0.0) 30 10)))
;; ks-relativize / ks-absolutize sind zueinander invers
(setq _ks '(("KS_EIN" ((100.0 200.0 300.0) (101.0 200.0 300.0)))))
(tu-eqf "ks-relativize+absolutize/invers"
_ks
(ks-absolutize (ks-relativize _ks '(10.0 20.0 30.0)) '(10.0 20.0 30.0)))
)
;; ------------------------------------------------------------
;; TESTS: vf_etage.lsp - Projektion der Randstuecke auf die Hauptachse
;; ------------------------------------------------------------
;; etage-laengs/-quer zerlegen einen um d gedreht eingebauten Blockvektor
;; (vx vy) in Laengs- und Queranteil bezogen auf die Hauptachse. Sie sind der
;; Kern von etage-rand-budget und damit der korrigierten Laengenbilanz.
(defun tu-tests-etage ( / _hp _vx _vy _l _q)
(princ "\n[vf_etage]")
(setq _hp (/ pi 2.0))
;; d=0: Block liegt schon auf der Hauptachse -> unveraendert
(tu-eqf "etage-laengs/d0" 250.0 (etage-laengs 250.0 67.0 0.0))
(tu-eqf "etage-quer/d0" 67.0 (etage-quer 250.0 67.0 0.0))
;; d=+90 Grad: Block-X zeigt quer, Block-Y entgegen der Hauptachse
(tu-eqf "etage-laengs/d+90" -67.0 (etage-laengs 250.0 67.0 _hp))
(tu-eqf "etage-quer/d+90" 250.0 (etage-quer 250.0 67.0 _hp))
;; REGRESSION (Nutzer-Befund 2026-10-09): das AS_Element_30 hat ein-ang=90
;; Grad, wird also mit d=-90 Grad eingebaut. Auf der Hauptachse landet dann
;; die Block-Y-Komponente (486.1), NICHT die Block-X-Komponente (209.7).
;; Der alte Solver nahm vx und verfehlte die Kettenlaenge um ~990 mm.
(tu-eqf "etage-laengs/AS-d-90-nimmt-vy" 486.1 (etage-laengs 209.7 486.1 (- _hp)))
(tu-eqf "etage-quer/AS-d-90" -209.7 (etage-quer 209.7 486.1 (- _hp)))
;; dito ES_Element_30 (ein-ang=120, Auslauf-Schwenk 30 -> d=-90)
(tu-eqf "etage-laengs/ES-d-90-nimmt-vy" 525.29 (etage-laengs -242.6 525.29 (- _hp)))
(tu-eqf "etage-quer/ES-d-90" 242.6 (etage-quer -242.6 525.29 (- _hp)))
;; Drehung ist laengentreu: laengs^2 + quer^2 = vx^2 + vy^2 (fuer jedes d)
(setq _vx 209.7 _vy 486.1)
(setq _l (etage-laengs _vx _vy 0.9) _q (etage-quer _vx _vy 0.9))
(tu-eqf "etage-laengs/quer-laengentreu"
(+ (* _vx _vx) (* _vy _vy))
(+ (* _l _l) (* _q _q)))
)
;; ------------------------------------------------------------
;; TESTS: vf_linienzug.lsp - ES-Fussabdruck entlang der Fahrtrichtung
;; ------------------------------------------------------------
;; vfl-es-laengs liefert die Laenge, die ein Segment fuer das ES-Element
;; reservieren muss. Getestet wird die Rueckfallkette: ohne sie wuerde ein
;; fehlender Messwert zu (- deltaL nil) und damit zum Absturz fuehren.
(defun tu-tests-vfl-es ( / _s-laengs _s-dx)
(princ "\n[vf_linienzug ES]")
;; globale Masse sichern - sie gehoeren dem laufenden Bau-Kontext
(setq _s-laengs ein-laengs _s-dx ein-dx)
;; Normalfall: ein-laengs ist gesetzt und wird genommen.
;; 576.2 = ES_Element_30_rechts entlang der Fahrtrichtung; (abs ein-dx)
;; waere 242.6 - genau die 333.65 mm, um die die Kette frueher zu weit ragte.
(setq ein-laengs 576.2 ein-dx -242.6)
(tu-eqf "vfl-es-laengs/nimmt-laengs-nicht-dx" 576.2 (vfl-es-laengs))
;; Vorzeichen: reserviert wird immer ein Betrag
(setq ein-laengs -576.2)
(tu-eqf "vfl-es-laengs/betrag" 576.2 (vfl-es-laengs))
;; Genulltes ein-dx gewinnt: die Null-Konvention der Bau-Pfade bedeutet
;; "ES anderswo schon beruecksichtigt - hier nichts reservieren". Ohne diese
;; Kopplung wuerde der Fix einen doppelten Abzug einbauen.
(setq ein-laengs 576.2 ein-dx 0.0)
(tu-eqf "vfl-es-laengs/genulltes-dx-gewinnt" 0.0 (vfl-es-laengs))
;; KS nicht lesbar -> Rueckfall auf das alte (zu kleine) Blockmass
(setq ein-laengs nil ein-dx -242.6)
(tu-eqf "vfl-es-laengs/fallback-auf-dx" 242.6 (vfl-es-laengs))
;; gar nichts gemessen -> 0.0, niemals nil (Absturzschutz)
(setq ein-dx nil)
(tu-eqf "vfl-es-laengs/fallback-null" 0.0 (vfl-es-laengs))
(setq ein-laengs _s-laengs ein-dx _s-dx)
)
;; ------------------------------------------------------------
;; TESTS: vf_linienzug.lsp - "Parallel zum Kreisel" (Rechenkerne)
;; ------------------------------------------------------------
;; Die Bau-Funktion vfl-gf-parallel-kreisel braucht eine Zeichnung (sie misst
;; AS und Bogen an echten Bloecken); ihre beiden Rechenkerne sind davon frei
;; und stehen deshalb hier:
;; vfl-par-bogen-waehlen - welcher Bogen hebt den AS-Schwenk auf?
;; vfl-par-gf-laenge - wie lang wird das GF-Stueck dazwischen?
;; Die Plan-Turn-Werte unten sind die Vorzeichen-Konvention aus
;; vf-element-plan-turn (KS_EIN -> KS_AUS in der XY-Ebene, links positiv).
(defun tu-tests-vfl-parallel ( / _b30 _b60 _b90 _kand _l _plan _plan3 _g _p _w)
(princ "\n[vf_linienzug Parallel zum Kreisel]")
;; --- Bogenwahl: der Bogen muss den AS-Schwenk GENAU aufheben ---
;; Rechts-Boegen schwenken negativ, Links-Boegen positiv.
(setq _b30 '(30 . -30.0) _b60 '(60 . -60.0) _b90 '(90 . -90.0))
(setq _kand (list _b30 _b60 _b90))
;; AS links 30 Grad (Schwenk +30) -> 30-Grad-Bogen nach rechts
(tu-eq "vfl-par-bogen/as30-rechts" 30 (vfl-par-bogen-waehlen 30.0 _kand 2.0))
;; AS links 90 Grad (Schwenk +90) -> 90-Grad-Bogen nach rechts
(tu-eq "vfl-par-bogen/as90-rechts" 90 (vfl-par-bogen-waehlen 90.0 _kand 2.0))
;; Generisch: auch ein 60-Grad-Schwenk findet seinen Bogen - die Zuordnung
;; folgt den gemessenen Bloecken, nicht einer gepflegten Tabelle.
(tu-eq "vfl-par-bogen/as60-rechts" 60 (vfl-par-bogen-waehlen 60.0 _kand 2.0))
;; kleine Messabweichung bleibt in der Toleranz
(tu-eq "vfl-par-bogen/toleranz-ok" 30 (vfl-par-bogen-waehlen 31.2 _kand 2.0))
;; ausserhalb der Toleranz: lieber nil als ein schiefer Bogen
(tu-nil "vfl-par-bogen/zu-weit-weg" (vfl-par-bogen-waehlen 45.0 _kand 2.0))
(tu-nil "vfl-par-bogen/leere-liste" (vfl-par-bogen-waehlen 30.0 '() 2.0))
;; Gegenseite: Links-Boegen heben einen negativen AS-Schwenk auf
(setq _kand (list '(30 . 30.0) '(60 . 60.0) '(90 . 90.0)))
(tu-eq "vfl-par-bogen/as-rechts30-links" 30 (vfl-par-bogen-waehlen -30.0 _kand 2.0))
;; --- GF-Laenge: abstand = perp-as + L*k + perp-bogen ---
;; Glatter Fall: k = 1 (AS schwenkt 90 Grad aus der Achse), feste Anteile
;; zusammen 500 -> fuer 2000 mm Abstand bleiben 1500 mm GF.
(tu-eqf "vfl-par-laenge/k1" 1500.0 (vfl-par-gf-laenge 2000.0 200.0 300.0 1.0))
;; Gegenseite: k negativ -> der Abstand zaehlt auf der anderen Seite, der
;; Betrag der Eingabe bleibt derselbe (Seite kommt aus der AS-Variante).
(tu-eqf "vfl-par-laenge/k-negativ" 1500.0
(vfl-par-gf-laenge 2000.0 -200.0 -300.0 -1.0))
;; Schraege Ausschleusung: k = sin(60 Grad)
(setq _l (vfl-par-gf-laenge 2000.0 0.0 0.0 (sin (/ (* 60.0 pi) 180.0))))
(tu-eqf "vfl-par-laenge/k-sin60" (/ 2000.0 (sin (/ (* 60.0 pi) 180.0))) _l)
;; Abstand kleiner als der feste Anteil -> negative Laenge (der Aufrufer
;; meldet das als "Abstand zu klein", die Rechnung selbst raet nicht).
(tu-true "vfl-par-laenge/zu-klein-negativ"
(< (vfl-par-gf-laenge 100.0 200.0 300.0 1.0) 0.0))
;; AS schwenkt gar nicht aus der Achse -> keine Loesung
(tu-nil "vfl-par-laenge/kein-versatz" (vfl-par-gf-laenge 2000.0 0.0 0.0 0.0))
;; --- Grenzen einer VF-Einheit (Modus 2) ---
;; Zwischen Umlenk- und Motorstation: hoechstens 2 Vario-Kurven und 25 m.
;; Plan-Eintraege: ("Linie" hz laenge ...) / ("Bogen" hz chord ...) - nur
;; Typ und Laenge (3. Feld) zaehlen hier.
(setq _plan (list '("Linie" 0.0 9000.0 "VF") '("Bogen" 0.0 500.0)
'("Linie" 0.0 8000.0 "VF") '("Bogen" 0.0 500.0)
'("Linie" 0.0 6000.0 "VF")))
;; 24000 mm, 2 Kurven -> alles im Rahmen
(setq _g (vfl-m2-lauf-grenzen _plan 0 4 25000.0 2))
(tu-eqf "vfl-m2-grenzen/laenge" 24000.0 (nth 0 _g))
(tu-eq "vfl-m2-grenzen/kurven" 2 (nth 1 _g))
(tu-nil "vfl-m2-grenzen/ok" (nth 2 _g))
;; Dritte Kurve -> an ihr (Index 5) teilen, obwohl die Laenge noch passt
(setq _plan3 (append _plan (list '("Bogen" 0.0 400.0) '("Linie" 0.0 300.0 "VF"))))
(tu-eq "vfl-m2-grenzen/dritte-kurve" 5 (nth 2 (vfl-m2-lauf-grenzen _plan3 0 6 25000.0 2)))
;; Zu lang -> am ersten Bogen teilen, nach dem die Grenze reisst (Index 3:
;; bis dahin sind 9000+500+8000 = 17500 drin, die Grenze liegt bei 15000).
(tu-eq "vfl-m2-grenzen/zu-lang" 3 (nth 2 (vfl-m2-lauf-grenzen _plan 0 4 15000.0 2)))
;; Eine einzige lange Gerade: zu lang, aber kein Bogen zum Teilen -> -1
(tu-eq "vfl-m2-grenzen/unteilbar" -1
(nth 2 (vfl-m2-lauf-grenzen (list '("Linie" 0.0 30000.0 "VF")) 0 0 25000.0 2)))
;; --- Vorgabewert aus einem Prompt ziehen (Dialog-Feld vorbelegen) ---
;; Die Konsolen-Prompts tragen ihre Vorgabe in Klammern; der Zahlen-Dialog
;; liest sie daraus. Gesucht ist die LETZTE Klammergruppe MIT Zahl - die
;; echten Texte enthalten davor "<" ohne Partner ("0 < Winkel <= 3") und
;; runde Klammern mit Fliesstext, beides darf nicht stoeren.
(tu-eq "vflw-vorgabe/neigungswinkel" "3"
(vflw-vorgabe-aus-prompt "\nNeigungswinkel (Grad, 0 < Winkel <= 3) [3]: "))
(tu-eq "vflw-vorgabe/neigungswinkel-berechnet" "3"
(vflw-vorgabe-aus-prompt
"\nNeigungswinkel (Grad, 0 < Winkel <= 3) [3] (deltaL wird berechnet und eingefuegt): "))
(tu-eq "vflw-vorgabe/spitze-klammer" "2154.0"
(vflw-vorgabe-aus-prompt "\nGewuenschte Hoehe am Kettenanfang (mm) <2154.0>: "))
(tu-eq "vflw-vorgabe/negativ" "-12.5"
(vflw-vorgabe-aus-prompt "Hoehendifferenz <-12.5>: "))
;; Ohne Klammergruppe bleibt das Feld leer (nil), nicht geraten.
(tu-nil "vflw-vorgabe/ohne-vorgabe"
(vflw-vorgabe-aus-prompt "\nAbstand zum Kreisel (mm, senkrecht zur Achse): "))
(tu-nil "vflw-vorgabe/keine-zahl"
(vflw-vorgabe-aus-prompt "Bitte Namen eingeben [frei]: "))
;; --- Modus-2-Lauf-Anfang: Journal-Wert normieren ---
;; Die Antwort wird als selbstbeschreibender Wert gefuehrt, damit ein
;; Umsortieren/Umnummerieren der Optionen bestehende Ketten nicht
;; umdeutet. Alte Ketten tragen dort noch die Ziffern der ALTEN Folge -
;; die Zuordnung dafuer steht als Tabelle in *vfl-m2-anfang-alt* und wird
;; hier komplett durchlaufen, statt einzelne Faelle abzuschreiben.
(foreach _p *vfl-m2-anfang-alt*
(tu-eq (strcat "vfl-m2-anfang/alt-" (car _p))
(cdr _p) (vfl-m2-anfang-norm (car _p))))
;; Jeder Tabellenwert muss auch ein gueltiger heutiger Wert sein - sonst
;; laeuft eine Alt-Kette in den Unbekannt-Abbruch.
(foreach _p *vfl-m2-anfang-alt*
(tu-true (strcat "vfl-m2-anfang/alt-ziel-gueltig-" (car _p))
(and (member (cdr _p) *vfl-m2-anfang-werte*) t)))
;; Neue Werte gehen unveraendert durch.
(foreach _w *vfl-m2-anfang-werte*
(tu-eq (strcat "vfl-m2-anfang/neu-" _w) _w (vfl-m2-anfang-norm _w)))
;; Unbekanntes wird NICHT geraten - nil heisst fuer den Aufrufer Abbruch.
(tu-nil "vfl-m2-anfang/unbekannte-ziffer" (vfl-m2-anfang-norm "4"))
(tu-nil "vfl-m2-anfang/leer" (vfl-m2-anfang-norm ""))
(tu-nil "vfl-m2-anfang/tippfehler" (vfl-m2-anfang-norm "mit_gf1"))
(tu-nil "vfl-m2-anfang/kein-string" (vfl-m2-anfang-norm 3))
(tu-nil "vfl-m2-anfang/nil" (vfl-m2-anfang-norm nil))
;; --- Rueckwaerts bauen: Punkt entgegen der Fahrtrichtung zuruecksetzen ---
;; vfl-rueck-punkt ist der Rechenkern des Rueckwaerts-Baus: zu einem
;; BEKANNTEN Endpunkt den Startpunkt eines Bausteins finden. Vorwaerts gilt
;; P_next = P + (L*cos hz, L*sin hz, -L*tan w) - hier also mit umgekehrtem
;; Vorzeichen. Die Hoehe muss STEIGEN (der Vorgaenger liegt hoeher).
(tu-eqf "vfl-rueck-punkt/ost-flach"
(list 0.0 0.0 0.0) (vfl-rueck-punkt '(1000.0 0.0 0.0) 0.0 1000.0 0.0))
(tu-eqf "vfl-rueck-punkt/nord-flach"
(list 0.0 0.0 0.0) (vfl-rueck-punkt '(0.0 1000.0 0.0) 90.0 1000.0 0.0))
;; 45 Grad Gefaelle: 1000 mm horizontal zurueck = 1000 mm hoeher
(tu-eqf "vfl-rueck-punkt/45-grad"
(list 0.0 0.0 1000.0) (vfl-rueck-punkt '(1000.0 0.0 0.0) 0.0 1000.0 45.0))
;; Rundlauf: vorwaerts wieder auf den Ausgangspunkt (3 Grad, schraeg)
(setq _l (vfl-rueck-punkt '(5000.0 3000.0 1800.0) 30.0 2000.0 3.0))
(tu-eqf "vfl-rueck-punkt/rundlauf-x" 5000.0
(+ (car _l) (* 2000.0 (cos (/ (* 30.0 pi) 180.0)))))
(tu-eqf "vfl-rueck-punkt/rundlauf-y" 3000.0
(+ (cadr _l) (* 2000.0 (sin (/ (* 30.0 pi) 180.0)))))
(tu-eqf "vfl-rueck-punkt/rundlauf-z" 1800.0
(- (caddr _l) (* 2000.0 (/ (sin (/ (* 3.0 pi) 180.0)) (cos (/ (* 3.0 pi) 180.0))))))
)
;; ------------------------------------------------------------
;; TESTS: vf_linienzug.lsp - Laenge aus einer Ziellinie (X/Y)
;; ------------------------------------------------------------
;; Steht die Fahrtrichtung fest, ist die Laenge nicht mehr frei: die (ggf.
;; seitlich versetzte) Bahn trifft die Ziellinie in genau einem Punkt.
;; REIN PLANAR - die Hoehe kommt weiterhin aus dem Gefaellewinkel.
(defun tu-tests-vfl-ziellinie ( / _p0 _l _ks)
(princ "\n[vf_linienzug Ziellinie]")
(tu-eqf "vfl-kreuz2/einheitsachsen" 1.0 (vfl-kreuz2 1.0 0.0 0.0 1.0))
(tu-eqf "vfl-kreuz2/parallel" 0.0 (vfl-kreuz2 2.0 4.0 1.0 2.0))
(setq _p0 '(0.0 0.0 0.0))
;; Fahrtrichtung 0 Grad, senkrechte Ziellinie bei x=1000 -> L=1000
(tu-eqf "vfl-laenge-bis-ziellinie/senkrecht"
1000.0 (vfl-laenge-bis-ziellinie _p0 0.0 0.0 '(1000.0 -500.0 0.0) '(1000.0 500.0 0.0)))
;; Querversatz verschiebt die BAHN seitlich, nicht laengs: bei einer zur
;; Fahrtrichtung senkrechten Ziellinie bleibt L deshalb gleich.
(tu-eqf "vfl-laenge-bis-ziellinie/querversatz-ohne-wirkung"
1000.0 (vfl-laenge-bis-ziellinie _p0 0.0 52.5 '(1000.0 -500.0 0.0) '(1000.0 500.0 0.0)))
;; 45-Grad-Ziellinie durch (1000,0): die um +100 versetzte Bahn trifft sie
;; 100 frueher (y=100 wird bei x=1100 erreicht -> ohne Versatz 1000+100).
(tu-eqf "vfl-laenge-bis-ziellinie/schraege-linie"
1100.0 (vfl-laenge-bis-ziellinie _p0 0.0 100.0 '(1000.0 0.0 0.0) '(2000.0 1000.0 0.0)))
;; Ziellinie PARALLEL zur Fahrtrichtung -> kein eindeutiger Treffer -> nil
(tu-nil "vfl-laenge-bis-ziellinie/parallel"
(vfl-laenge-bis-ziellinie _p0 0.0 0.0 '(0.0 500.0 0.0) '(1000.0 500.0 0.0)))
;; Z der Ziellinie ist irrelevant (rein planare Rechnung, Nutzer-Vorgabe):
;; dieselbe Linie auf anderer Hoehe liefert dasselbe L.
(tu-eqf "vfl-laenge-bis-ziellinie/z-ignoriert"
1000.0 (vfl-laenge-bis-ziellinie _p0 0.0 0.0 '(1000.0 -500.0 7777.0) '(1000.0 500.0 -99.0)))
;; Realfall aus dem Nutzer-Log: nach dem 30-Grad-Bogen steht die Kette bei
;; (901.21,-2728.97) mit hz=-120; das ES-KS_AUS laeuft 52.51 mm versetzt und
;; landete bei (231.42,-3994.11). Eine Ziellinie durch diesen Punkt quer zur
;; Fahrtrichtung muss genau die damals gebaute Gesamtlaenge liefern.
(setq _ks '(231.42 -3994.11 0.0))
(setq _l (vfl-laenge-bis-ziellinie '(901.21 -2728.97 0.0) -120.0 52.51
_ks (list (+ (car _ks) (cos (/ pi 6.0))) ; 30 Grad = quer zu -120
(+ (cadr _ks) (sin (/ pi 6.0))) 0.0)))
(tu-true "vfl-laenge-bis-ziellinie/realfall-plausibel"
(and _l (> _l 1430.0) (< _l 1431.0)))
;; --- AS-Seite aus der Lage des naechsten Punkts zur Basislinie ---
;; Basislinie zeigt nach +X; ein Ziel mit +Y liegt links davon, mit -Y rechts.
(tu-eq "vfl-seite-aus-lage/links"
"links" (vfl-seite-aus-lage '(0.0 0.0 0.0) '(1000.0 0.0 0.0) '(500.0 800.0 0.0)))
(tu-eq "vfl-seite-aus-lage/rechts"
"rechts" (vfl-seite-aus-lage '(0.0 0.0 0.0) '(1000.0 0.0 0.0) '(500.0 -800.0 0.0)))
;; Richtung der Basislinie umdrehen -> Seite dreht mit
(tu-eq "vfl-seite-aus-lage/basislinie-umgedreht"
"rechts" (vfl-seite-aus-lage '(1000.0 0.0 0.0) '(0.0 0.0 0.0) '(500.0 800.0 0.0)))
;; schraege Basislinie (45 Grad): Ziel oberhalb davon liegt links
(tu-eq "vfl-seite-aus-lage/schraeg"
"links" (vfl-seite-aus-lage '(0.0 0.0 0.0) '(1000.0 1000.0 0.0) '(0.0 1000.0 0.0)))
;; Z spielt keine Rolle (rein planare Entscheidung)
(tu-eq "vfl-seite-aus-lage/z-ignoriert"
"rechts" (vfl-seite-aus-lage '(0.0 0.0 5000.0) '(1000.0 0.0 -200.0) '(500.0 -800.0 999.0)))
;; --- VF-Hoehe je SEGMENT (Attribut VF_HOEHE_m, Sivas 4433-4437) ---
;; Ein Eintrag je GERADEM VF-Abschnitt: Mittelwert aus dessen KS_EIN und
;; KS_AUS, in METERN mit 3 Nachkommastellen. Zwischen Umlenk- und
;; Motorstation koennen mehrere Abschnitte liegen (auf/ab/horizontal), die
;; Liste laeuft darum parallel zu L_VF_m und VF_WINKEL.
(vf-vfhoehe-reset)
(tu-eq "vf-vfhoehe/leer-nach-reset" "" (vfl-join-komma *vf-acc-vfhoehe*))
;; 2000 mm und 3000 mm -> Mittel 2500 mm -> "2.500"
(vf-vfhoehe-segment 2000.0 3000.0)
(tu-eq "vf-vfhoehe/mittelwert-meter" "2.500" (vfl-join-komma *vf-acc-vfhoehe*))
;; Drei Abschnitte wie im realen Block (L_VF_m hatte dort 3 Eintraege):
;; horizontal, horizontal, steigend - alle drei bekommen einen Wert.
(vf-vfhoehe-reset)
(vf-vfhoehe-segment 2076.0 2076.0) ; horizontal
(vf-vfhoehe-segment 2076.0 2076.0) ; horizontal
(vf-vfhoehe-segment 2076.0 2600.0) ; steigend -> Mittel 2338
(tu-eq "vf-vfhoehe/drei-abschnitte"
"2.076,2.076,2.338" (vfl-join-komma *vf-acc-vfhoehe*))
;; Unvollstaendige Messung haengt NICHTS an - sonst verschoebe sich die
;; Liste gegen L_VF_m und eine Hoehe landete beim falschen Foerderer.
(vf-vfhoehe-reset)
(vf-vfhoehe-segment 1000.0 2000.0)
(vf-vfhoehe-segment nil 3000.0)
(vf-vfhoehe-segment 4000.0 nil)
(tu-eq "vf-vfhoehe/unvollstaendig-ignoriert" "1.500" (vfl-join-komma *vf-acc-vfhoehe*))
;; negative Hoehen (Kette unter Null) muessen durchgehen
(vf-vfhoehe-reset)
(vf-vfhoehe-segment -500.0 -1500.0)
(tu-eq "vf-vfhoehe/negativ" "-1.000" (vfl-join-komma *vf-acc-vfhoehe*))
(vf-vfhoehe-reset)
;; vf-meter-3: GENAU 3 Nachkommastellen, unabhaengig von DIMZIN.
;; (rtos x 2 3) allein kuerzt nachfolgende Nullen ("2.5", "-1") - real im
;; Testlauf aufgetreten, deshalb eigene Formatierung.
(tu-eq "vf-meter-3/glatt" "2.500" (vf-meter-3 2500.0))
(tu-eq "vf-meter-3/ganzzahlig" "3.000" (vf-meter-3 3000.0))
(tu-eq "vf-meter-3/negativ" "-1.000" (vf-meter-3 -1000.0))
(tu-eq "vf-meter-3/null" "0.000" (vf-meter-3 0.0))
(tu-eq "vf-meter-3/drei-stellen" "1.234" (vf-meter-3 1234.0))
;; --- SONDERFALL Standard/Etage: Hoehe ueber die GANZE Kette ---
;; Nur ein Motor und nur ein gerader VF-Abschnitt, darum zaehlt dort
;; AS-KS_EIN .. ES-KS_AUS statt des Segmentwerts (Nutzer-Vorgabe 2026-10-21).
(vf-vfhoehe-reset)
(vf-vfhoehe-kette 1000.0 3000.0)
(tu-eq "vf-vfhoehe-kette/mittelwert" "2.000" (vfl-join-komma *vf-acc-vfhoehe*))
;; ERSETZT den beim Bau gesammelten Segmentwert, haengt ihn NICHT an -
;; sonst stuenden fuer eine Standard-Anlage zwei Hoehen in der Liste.
(vf-vfhoehe-reset)
(vf-vfhoehe-segment 5000.0 5000.0) ; Segmentwert aus vfs-vf-koerper
(vf-vfhoehe-kette 1000.0 3000.0)
(tu-eq "vf-vfhoehe-kette/ersetzt-segmentwert" "2.000" (vfl-join-komma *vf-acc-vfhoehe*))
;; fehlender Endpunkt -> lieber leer als geraten
(vf-vfhoehe-reset)
(vf-vfhoehe-kette 1000.0 nil)
(tu-eq "vf-vfhoehe-kette/ohne-endpunkt-leer" "" (vfl-join-komma *vf-acc-vfhoehe*))
(vf-vfhoehe-reset)
)
;; ------------------------------------------------------------
;; TESTS: export.lsp - CSV/KOS-Kodierung
;; ------------------------------------------------------------
(defun tu-tests-export ()
(princ "\n[export]")
(tu-eq "csv:clamp/innen" 5 (csv:clamp 5 0 10))
(tu-eq "csv:clamp/unten" 0 (csv:clamp -3 0 10))
(tu-eq "csv:clamp/oben" 10 (csv:clamp 20 0 10))
(tu-eqf "csv:z-angle-to-quat/0" '(0.0 0.0 0.0 1.0) (csv:z-angle-to-quat 0))
(tu-eqf "csv:z-angle-to-quat/180" '(0.0 0.0 1.0 0.0) (csv:z-angle-to-quat 180))
(tu-eq "csv:b64-encode-ints/0" "AAAA" (csv:b64-encode-ints '(0)))
(tu-eq "csv:trans-encode/0-0-0" "AAAAAAAAAAAA" (csv:trans-encode 0.0 0.0 0.0))
;; local-to-world: Eltern-Orientierung als 3x3-Rotationsmatrix (mat3-rz
;; liefert die Z-Drehmatrix aus dem Winkel - Signatur seit dem
;; Extrusions-Fix in export.lsp: parent-R statt parent-rot-rad).
(tu-eqf "csv:local-to-world/keine-drehung"
'(1.0 0.0 0.0) (csv:local-to-world '(0.0 0.0 0.0) (mat3-rz 0.0) '(1.0 0.0 0.0)))
(tu-eqf "csv:local-to-world/90-grad"
'(0.0 1.0 0.0) (csv:local-to-world '(0.0 0.0 0.0) (mat3-rz (/ pi 2.0)) '(1.0 0.0 0.0)))
;; json-escape: Anfuehrungszeichen maskieren
(tu-eq "csv:json-escape/quote" "a\\\"b" (csv:json-escape "a\"b"))
;; --- csv:sepliste-kette-paare: sepliste-Eintrag <-> Kettenbaustein -------
;; Zuordnung ueber die Reihenfolge je Typ (k-tes AS/SEP/ES der sepliste =
;; k-tes der geordneten Kette), Rueckgabe ((lfdnr . index) ...).
(tu-nil "csv:sepliste-kette-paare/leer" (csv:sepliste-kette-paare nil nil))
;; HundM05-artige Kette: Koordinaten spielen keine Rolle (auch gespiegelte
;; x-Werte aendern nichts), Bausteine ohne sepliste-Typ werden uebersprungen.
(setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 -9999.0 0.0) ("SEP" 3 2000.0 0.0) ("ES" 4 3000.0 0.0)))
(tu-eq "csv:sepliste-kette-paare/kette"
'((1 . 0) (2 . 2) (3 . 5) (4 . 7))
(csv:sepliste-kette-paare _e
'("AS" "STRECKENELEMENT" "SEP" "UMLENKSTATION" "MOTORSTATION" "SEP" "BOGEN" "ES")))
;; lfdnr-Reihenfolge zaehlt, nicht die Reihenfolge der Eintraege in der Liste.
(setq _e '(("SEP" 3 0.0 0.0) ("AS" 1 0.0 0.0) ("SEP" 2 0.0 0.0)))
(tu-eq "csv:sepliste-kette-paare/unsortiert"
'((1 . 0) (2 . 1) (3 . 2))
(csv:sepliste-kette-paare _e '("AS" "SEP" "SEP")))
;; Mehr Eintraege als Bausteine: die ueberzaehligen bleiben ohne Partner.
(setq _e '(("AS" 1 0.0 0.0) ("SEP" 2 0.0 0.0) ("SEP" 3 0.0 0.0)))
(tu-eq "csv:sepliste-kette-paare/fehlender-baustein"
'((1 . 0) (2 . 2))
(csv:sepliste-kette-paare _e '("AS" "BOGEN" "SEP" "ES")))
;; --- csv:asmark-finden: bisherigen AS/ES-Marker im Bestand wiederfinden ---
;; Schluessel ist (Wrapper-ID, Typ, lfdnr) - alle drei muessen passen, sonst
;; bekaeme ein Kettenende die ID eines fremden Markers. Bestandsformat:
;; (ename zuordnung typ lfdnr id), siehe csv:asmark-sammeln.
(setq _mk '((ME1 "0021" "AS" "1" "0031")
(ME2 "0021" "ES" "4" "0032")
(ME3 "0022" "AS" "1" "0033")))
(tu-eq "csv:asmark-finden/treffer"
'(ME2 "0021" "ES" "4" "0032") (csv:asmark-finden _mk "0021" "ES" "4"))
(tu-eq "csv:asmark-finden/anderer-wrapper"
'(ME3 "0022" "AS" "1" "0033") (csv:asmark-finden _mk "0022" "AS" "1"))
(tu-nil "csv:asmark-finden/falsche-lfdnr" (csv:asmark-finden _mk "0021" "AS" "2"))
(tu-nil "csv:asmark-finden/falscher-typ" (csv:asmark-finden _mk "0021" "SEP" "1"))
(tu-nil "csv:asmark-finden/ohne-wrapper-id" (csv:asmark-finden _mk "" "AS" "1"))
(tu-nil "csv:asmark-finden/leerer-bestand" (csv:asmark-finden nil "0021" "AS" "1"))
;; csv:asmark-res-key: Schluessel der reservierten ID am Wrapper - lfdnr als
;; Integer (csv:asmark-aktualisieren) und String muss denselben liefern.
(tu-eq "csv:asmark-res-key/int" "AS|1" (csv:asmark-res-key "AS" 1))
(tu-eq "csv:asmark-res-key/str" "ES|4" (csv:asmark-res-key "ES" "4"))
(tu-eq "csv:res-key-kette" "K|7" (csv:res-key-kette 7))
(tu-eq "csv:res-key-einheit" "U|2" (csv:res-key-einheit 2))
;; csv:res-merken: Anmeldungen je Wrapper zusammenfuehren (ein Eintrag je
;; Wrapper, Reihenfolge der Anmeldung). Symbole statt enames - rein
;; listenbasiert. Globale Sammlung sichern und wiederherstellen.
(setq _rs *csv-res-sammlung* *csv-res-sammlung* nil)
(csv:res-merken 'W1 "AS|1" 'M1)
(csv:res-merken 'W2 "K|0" 'M2)
(csv:res-merken 'W1 "K|3" 'M3)
(tu-eq "csv:res-merken/je-wrapper"
'((W1 ("AS|1" . M1) ("K|3" . M3)) (W2 ("K|0" . M2)))
(vl-sort *csv-res-sammlung* (function (lambda (a b) (< (vl-symbol-name (car a))
(vl-symbol-name (car b)))))))
(setq *csv-res-sammlung* _rs)
;; csv:pattern-nested-element: Suchmuster = alle Familienmuster aus
;; csv:element-familien - jede Familie ist also auch klassifizierbar.
(tu-eq "csv:pattern-nested-element/aus-familien"
(ssg-join (mapcar 'cdr (csv:element-familien)) ",")
(csv:pattern-nested-element))
(tu-true "csv:element-familien/jedes-muster-klassifiziert"
(not (vl-some (function (lambda (f)
(not (equal (car f) (csv:element-teileart
(vl-string-subst "X" "*"
(substr (cdr f) 1 (cond ((vl-string-search "," (cdr f)))
((strlen (cdr f)))))))))))
(csv:element-familien))))
;; csv:element-teileart: TeileArt-Familie eines ausgepackten VF_n/GF_n-
;; Bausteins aus dem Blocknamen (Boegen/Streckenelement/Umlenk-/Motor-
;; station). Vario_Bogen_* deckt sowohl die _TEF_- als auch die reine
;; GF-Variante ab, beide auf denselben Bucket "BOGEN".
(tu-eq "csv:element-teileart/gefaellebogen" "BOGEN"
(csv:element-teileart "Gefaellebogen_links_90_R500"))
(tu-eq "csv:element-teileart/vario-bogen-tef" "BOGEN"
(csv:element-teileart "Vario_Bogen_auf_3_TEF_rechts"))
(tu-eq "csv:element-teileart/vario-bogen-gf" "BOGEN"
(csv:element-teileart "Vario_Bogen_ab_6_rechts"))
(tu-eq "csv:element-teileart/vario-kurve" "BOGEN"
(csv:element-teileart "Vario_Kurve_links_30_TEF_innen"))
(tu-eq "csv:element-teileart/streckenelement" "STRECKENELEMENT"
(csv:element-teileart "Staustrecke_SP_1000_mm"))
(tu-eq "csv:element-teileart/umlenkstation" "UMLENKSTATION"
(csv:element-teileart "Vario_Umlenkstation_500mm_links"))
(tu-eq "csv:element-teileart/motorstation" "MOTORSTATION"
(csv:element-teileart "Vario_Motorstation_500mm_rechts"))
(tu-eq "csv:element-teileart/unbekannt" nil
(csv:element-teileart "AS_Element_90_links"))
;; --- csv:kette-typ: Bausteintyp einer VF_n/GF_n-Kette aus dem Blocknamen --
(tu-eq "csv:kette-typ/as" "AS" (csv:kette-typ "AS_Element_90_links_3D"))
(tu-eq "csv:kette-typ/es" "ES" (csv:kette-typ "ES_Element_30_rechts_2D"))
(tu-eq "csv:kette-typ/sep" "SEP" (csv:kette-typ "Staustrecke_Separator_SP_300_mm_3D"))
(tu-eq "csv:kette-typ/streckenelement" "STRECKENELEMENT"
(csv:kette-typ "Staustrecke_SP_1000_mm_3D"))
(tu-eq "csv:kette-typ/umlenk" "UMLENKSTATION"
(csv:kette-typ "Vario_Umlenkstation_500mm_rechts_3D"))
(tu-nil "csv:kette-typ/symbol-ist-kein-baustein" (csv:kette-typ "Separator_SP_3D"))
;; --- csv:kette-einheiten: geordnete Typfolge in VF-/GF-Einheiten schneiden
;; VF = Separator vor der Umlenkstation ... Motorstation; alles dazwischen
;; GF; AS/ES gehoeren zu keiner Einheit. Reine Rechenfunktion.
;; HundM05 VF_5 (Bausteinfolge aus der Testzeichnung, per KS-Kette geordnet):
;; GF(1) VF(2..10) GF(11 12) VF(13..25) GF(26 27) - passt zu L_GF_m
;; "0.727,0.201,0.318" des Wrappers (drei Gefaelleabschnitte).
(setq _kette-hundm05
'("AS" "STRECKENELEMENT" "SEP" "UMLENKSTATION" "BOGEN" "STRECKENELEMENT"
"BOGEN" "STRECKENELEMENT" "BOGEN" "BOGEN" "MOTORSTATION" "SEP"
"STRECKENELEMENT" "SEP" "UMLENKSTATION" "BOGEN" "STRECKENELEMENT" "BOGEN"
"BOGEN" "BOGEN" "STRECKENELEMENT" "BOGEN" "BOGEN" "STRECKENELEMENT" "BOGEN"
"MOTORSTATION" "STRECKENELEMENT" "SEP" "ES"))
(tu-eq "csv:kette-einheiten/hundm05"
'(("GF" (1)) ("VF" (2 3 4 5 6 7 8 9 10)) ("GF" (11 12))
("VF" (13 14 15 16 17 18 19 20 21 22 23 24 25)) ("GF" (26 27)))
(csv:kette-einheiten _kette-hundm05))
;; Reine Gefaellestrecke ohne Stationen -> eine einzige GF.
(tu-eq "csv:kette-einheiten/nur-gf"
'(("GF" (1 2 3)))
(csv:kette-einheiten '("AS" "STRECKENELEMENT" "BOGEN" "SEP" "ES")))
;; Kette beginnt direkt mit dem Foerderer (Separator gleich hinter dem AS),
;; endet mit der Motorstation vor dem ES -> nur eine VF, keine leeren GF.
(tu-eq "csv:kette-einheiten/nur-vf"
'(("VF" (1 2 3 4)))
(csv:kette-einheiten '("AS" "SEP" "UMLENKSTATION" "STRECKENELEMENT" "MOTORSTATION" "ES")))
;; Umlenkstation ohne Separator davor beginnt die VF selbst; der Separator,
;; der NICHT vor einer Umlenkstation steht, bleibt im Gefaelle.
(tu-eq "csv:kette-einheiten/umlenk-ohne-sep"
'(("GF" (1 2)) ("VF" (3 4 5)))
(csv:kette-einheiten '("AS" "SEP" "BOGEN" "UMLENKSTATION" "STRECKENELEMENT" "MOTORSTATION" "ES")))
;; --- csv:kette-sep-typen: Separator erbt den Typ seiner Einheit ---
;; HundM05 VF_5: Einlauf-Separator vor der Umlenkstation (2) -> VF; der
;; Separator hinter der Motorstation (11) -> GF; der Separator hinter dem
;; Gefaellestueck, der zugleich Einlauf der zweiten VF ist (13) -> VF; der
;; Separator vor dem ES (27) -> GF.
(tu-eq "csv:kette-sep-typen/hundm05"
'((2 . "VF") (11 . "GF") (13 . "VF") (27 . "GF"))
(csv:kette-sep-typen _kette-hundm05))
;; Separator INNERHALB der VF (vor der Motorstation) -> VF.
(tu-eq "csv:kette-sep-typen/sep-im-koerper"
'((1 . "VF") (4 . "VF") (7 . "GF"))
(csv:kette-sep-typen '("AS" "SEP" "UMLENKSTATION" "STRECKENELEMENT" "SEP"
"STRECKENELEMENT" "MOTORSTATION" "SEP" "ES")))
;; Reine Gefaellestrecke -> alle GF; Kette ohne Separator -> nil.
(tu-eq "csv:kette-sep-typen/nur-gf"
'((1 . "GF") (3 . "GF"))
(csv:kette-sep-typen '("AS" "SEP" "STRECKENELEMENT" "SEP" "ES")))
(tu-nil "csv:kette-sep-typen/ohne-sep"
(csv:kette-sep-typen '("AS" "STRECKENELEMENT" "ES")))
;; --- csv:kette-ordnen: Vektorkette K2 -> K1, unabhaengig von der
;; Eingangsreihenfolge; Start am AS. rec wird dafuer nicht gebraucht (nil).
(setq _t-as (list "AS" nil '(0.0 0.0 0.0) '(10.0 0.0 0.0)))
(setq _t-s1 (list "STRECKENELEMENT" nil '(10.0 0.0 0.0) '(20.0 0.0 0.0)))
(setq _t-b (list "BOGEN" nil '(20.0 0.0 0.0) '(20.0 10.0 0.0)))
(setq _t-es (list "ES" nil '(20.0 10.0 0.0) '(30.0 10.0 0.0)))
(tu-eq "csv:kette-ordnen/verwuerfelt"
(list _t-as _t-s1 _t-b _t-es)
(csv:kette-ordnen (list _t-b _t-es _t-as _t-s1) "TEST"))
;; Innerhalb der Toleranz (2 mm) gilt ein Anschluss noch als geschlossen.
(setq _t-s1b (list "STRECKENELEMENT" nil '(11.5 0.0 0.0) '(20.0 0.0 0.0)))
(tu-eq "csv:kette-ordnen/toleranz"
(list _t-as _t-s1b)
(csv:kette-ordnen (list _t-s1b _t-as) "TEST"))
;; --- csv:export-modus-setzen / -p-Praedikate: 3 Modi + Ungueltig-Schutz --
;; Bestehenden Modus sichern/wiederherstellen, damit dieser Testblock keine
;; Seiteneffekte auf nachfolgende Tests oder eine laufende Sitzung hat.
;; --- Hilfskopien behalten: EIN Schalter (csv_leave_proxies), der Dialog
;; schaltet denselben Zustand. Alten Wert sichern/wiederherstellen.
(setq _hk-alt (csv:hilfskopien-behalten-p))
(csv:hilfskopien-behalten-setzen T)
(tu-true "csv:hilfskopien-behalten/an" (csv:hilfskopien-behalten-p))
(tu-true "csv:hilfskopien-behalten/an-ist-dbg-schalter" (dbg-schalter-p "csv_leave_proxies"))
(csv:hilfskopien-behalten-setzen nil)
(tu-nil "csv:hilfskopien-behalten/aus" (csv:hilfskopien-behalten-p))
(csv:hilfskopien-behalten-setzen _hk-alt)
(setq _modus-alt *csv-export-modus*)
(csv:export-modus-setzen "all_elements")
(tu-eq "csv:export-modus-setzen/all_elements" "all_elements" *csv-export-modus*)
(tu-true "csv:export-alle-elemente-p/all_elements" (csv:export-alle-elemente-p))
(tu-nil "csv:export-separator-track-p/all_elements" (csv:export-separator-track-p))
(csv:export-modus-setzen "group_vf_gf")
(tu-eq "csv:export-modus-setzen/group_vf_gf" "group_vf_gf" *csv-export-modus*)
(tu-nil "csv:export-alle-elemente-p/group_vf_gf" (csv:export-alle-elemente-p))
(tu-nil "csv:export-separator-track-p/group_vf_gf" (csv:export-separator-track-p))
(csv:export-modus-setzen "separator_track")
(tu-eq "csv:export-modus-setzen/separator_track" "separator_track" *csv-export-modus*)
(tu-nil "csv:export-alle-elemente-p/separator_track" (csv:export-alle-elemente-p))
(tu-true "csv:export-separator-track-p/separator_track" (csv:export-separator-track-p))
;; Ungueltiger Wert wird ignoriert - Modus bleibt auf dem zuletzt gueltig
;; gesetzten Stand (hier "separator_track").
(csv:export-modus-setzen "unbekannt")
(tu-eq "csv:export-modus-setzen/ungueltig-ignoriert" "separator_track" *csv-export-modus*)
(csv:export-modus-setzen _modus-alt)
;; --- Gefrorene Layer: Schalter + Hilfskopien-Ausschluss (file-frei) ---
;; Records (hilfsobjekt wrapper ...) mit Symbolen als Stand-ins fuer
;; Entities; das Praedikat ersetzt ssg-ent-layer-gefroren-p.
(setq _gef-alt (csv:gefrorene-ausschliessen-p))
(csv:gefrorene-ausschliessen-setzen T)
(tu-true "csv:gefrorene-ausschliessen/an" (csv:gefrorene-ausschliessen-p))
(csv:gefrorene-ausschliessen-setzen nil)
(tu-nil "csv:gefrorene-ausschliessen/aus" (csv:gefrorene-ausschliessen-p))
(csv:gefrorene-ausschliessen-setzen _gef-alt)
(setq _gef-recs '((sep1 vf1 "SEP") (sep2 vf2 "SEP") (mark1 vf1 "AS") (unit1 gf1 "E" 1)))
(tu-eq "csv:hilfskopien-ausschluss/wrapper-vf1-gefroren" '(sep1 mark1)
(csv:hilfskopien-ausschluss _gef-recs (function (lambda (w) (eq w 'vf1)))))
(tu-eq "csv:hilfskopien-ausschluss/zwei-wrapper" '(sep2 unit1)
(csv:hilfskopien-ausschluss _gef-recs
(function (lambda (w) (member w '(vf2 gf1))))))
(tu-nil "csv:hilfskopien-ausschluss/nichts-gefroren"
(csv:hilfskopien-ausschluss _gef-recs (function (lambda (w) nil))))
(tu-nil "csv:hilfskopien-ausschluss/leere-liste"
(csv:hilfskopien-ausschluss nil (function (lambda (w) T))))
(tu-nil "csv:hilfskopien-ausschluss/record-ohne-wrapper"
(csv:hilfskopien-ausschluss '((sep1)) (function (lambda (w) T))))
)
;; ------------------------------------------------------------
;; TESTS: export.lsp - Hoehen-Attribute aus Z neu berechnen
;; ------------------------------------------------------------
(defun tu-tests-hoehen ( / _w)
(princ "\n[export/hoehen]")
;; Nicht verschoben -> nil (Block bleibt beim Bau-Wert)
(tu-nil "csv:hoehen-werte/kreisel-unveraendert"
(csv:hoehen-werte "KREISEL" 2000.0 '(("HOEHE" . "2000") ("MONTAGEHOEHE_m" . "1.800"))))
(tu-nil "csv:hoehen-werte/vf-unveraendert"
(csv:hoehen-werte "VF" 2000.0 '(("HOEHE_VON_mm" . "2000") ("HOEHE_BIS_mm" . "1876"))))
;; Kreisel / Eckrad verschoben
(setq _w (csv:hoehen-werte "KREISEL" 2500.0 '(("HOEHE" . "2000"))))
(tu-eq "csv:hoehen-werte/kreisel-hoehe" "2500" (cdr (assoc "HOEHE" _w)))
(tu-eqf "csv:hoehen-werte/kreisel-montage" 2.5 (atof (cdr (assoc "MONTAGEHOEHE_m" _w))))
(setq _w (csv:hoehen-werte "ECKRAD" 1500.0 '(("HOEHE" . "2000"))))
(tu-eq "csv:hoehen-werte/eckrad-hoehe" "1500" (cdr (assoc "HOEHE" _w)))
(tu-nil "csv:hoehen-werte/eckrad-ohne-montage" (assoc "MONTAGEHOEHE_m" _w))
;; GF abwaerts: Differenz 124 bleibt, MONTAGE = VON/1000
(setq _w (csv:hoehen-werte "GF" 2500.0
'(("HOEHE_VON_mm" . "2000") ("HOEHE_BIS_mm" . "1876") ("DELTA_H_mm" . "123"))))
(tu-eq "csv:hoehen-werte/gf-von" "2500" (cdr (assoc "HOEHE_VON_mm" _w)))
(tu-eq "csv:hoehen-werte/gf-bis" "2376" (cdr (assoc "HOEHE_BIS_mm" _w)))
(tu-eqf "csv:hoehen-werte/gf-montage" 2.5 (atof (cdr (assoc "MONTAGEHOEHE_m" _w))))
;; VF steigend ("Auf"): BIS liegt ueber VON, DELTA_H_mm ohne Vorzeichen
(setq _w (csv:hoehen-werte "VF" 1000.0
'(("HOEHE_VON_mm" . "2000") ("HOEHE_BIS_mm" . "2400") ("DELTA_H_mm" . "400"))))
(tu-eq "csv:hoehen-werte/vf-auf-von" "1000" (cdr (assoc "HOEHE_VON_mm" _w)))
(tu-eq "csv:hoehen-werte/vf-auf-bis" "1400" (cdr (assoc "HOEHE_BIS_mm" _w)))
(tu-eqf "csv:hoehen-werte/vf-auf-montage" 1.2 (atof (cdr (assoc "MONTAGEHOEHE_m" _w))))
;; VF ohne VON/BIS -> Rueckfall z - DELTA_H_mm
(setq _w (csv:hoehen-werte "VF" 3000.0 '(("DELTA_H_mm" . "500"))))
(tu-eq "csv:hoehen-werte/vf-rueckfall-bis" "2500" (cdr (assoc "HOEHE_BIS_mm" _w)))
)
;; ------------------------------------------------------------
;; TESTS: Gefaellestrecke.lsp - Geometrie-/Listen-Helfer
;; ------------------------------------------------------------
(defun tu-tests-gf ()
(princ "\n[Gefaellestrecke]")
(tu-eq "gf-snap-bogenwinkel/30" 30 (gf-snap-bogenwinkel 30))
(tu-eq "gf-snap-bogenwinkel/44" 30 (gf-snap-bogenwinkel 44))
(tu-eq "gf-snap-bogenwinkel/60" 60 (gf-snap-bogenwinkel 60))
(tu-eq "gf-snap-bogenwinkel/90" 90 (gf-snap-bogenwinkel 90))
(tu-eq "gf-bogen-blockname"
"Gefaellebogen_links_90_R500" (gf-bogen-blockname 90 "links"))
(tu-eqf "gf-abstand-2d/3-4" 5.0 (gf-abstand-2d '(0.0 0.0) '(3.0 4.0)))
(tu-eqf "gf-hz-winkel/rechts" 0.0 (gf-hz-winkel '(0.0 0.0) '(1.0 0.0)))
(tu-eqf "gf-hz-winkel/oben" 90.0 (gf-hz-winkel '(0.0 0.0) '(0.0 1.0)))
(tu-eq "gf-replace-nth" '(a x c) (gf-replace-nth '(a b c) 1 'x))
;; gf-exit-hz: Ausgangsrichtung nach letztem Segment
(tu-eqf "gf-exit-hz/linie" 45.0 (gf-exit-hz '(("Linie" 45.0))))
(tu-eqf "gf-exit-hz/bogen-links"
90.0 (gf-exit-hz '(("Linie" 0.0) ("Bogen" 0.0 nil 90 "links"))))
)
;; ------------------------------------------------------------
;; TESTS: OmniModulInsert.lsp - Datensatz-Helfer
;; ------------------------------------------------------------
(defun tu-tests-omni ()
(princ "\n[OmniModulInsert]")
(tu-eq "omni:sivasid-to-str/int" "42" (omni:sivasid-to-str 42))
(tu-eq "omni:sivasid-to-str/str" "abc" (omni:sivasid-to-str "abc"))
(tu-eq "omni:sivasid-to-str/real" "3" (omni:sivasid-to-str 3.0))
;; Mock-Datensatz (Struktur wie ssg-load-json liefern wuerde)
(setq _lst
'((("Sivasnr" . 100) ("KurvenWinkel" . 45) ("Radius" . 550))
(("Sivasnr" . 200) ("KurvenWinkel" . 90) ("Radius" . 400))
(("Sivasnr" . 300) ("KurvenWinkel" . 45) ("Radius" . 750))))
(tu-eq "omni:val" 400 (omni:val (omni:get-by-sivasid _lst 200) "Radius"))
(tu-nil "omni:get-by-sivasid/fehlt" (omni:get-by-sivasid _lst 999))
(tu-eq "omni:filter/anzahl" 2 (length (omni:filter _lst "KurvenWinkel" 45)))
(tu-eq "omni:filter/wert"
100 (cdr (assoc "Sivasnr" (car (omni:filter _lst "KurvenWinkel" 45)))))
;; Verbinder-Pfad: Backslashes normalisiert, abschliessender Trenner entfernt
(tu-eq "omni:verbinder-pfad/backslash"
"C:/x/data/omniflo/Verbinder/TV_W-W_kpl.dwg"
(omni:verbinder-pfad "C:\\x\\data" "TV_W-W_kpl"))
(tu-eq "omni:verbinder-pfad/trenner"
"C:/x/data/omniflo/Verbinder/VB_ENDP_AP.dwg"
(omni:verbinder-pfad "C:/x/data/" "VB_ENDP_AP"))
)
;; ------------------------------------------------------------
;; TESTS: KreiselInsert.lsp - Geometrie-Helfer
;; ------------------------------------------------------------
(defun tu-tests-kreisel ( / _e)
(princ "\n[KreiselInsert]")
;; Drehrichtungspfeil: AN8-Mitte 90 Grad, SP8-Mitte 270 Grad, GUZ gespiegelt
(tu-eqf "kreisel-pfeil-params/uzs"
'(((400.0 0.0 0.0) 90.0 1.0) ((2700.0 0.0 0.0) 270.0 1.0))
(kreisel-pfeil-params 400.0 2300.0 "UZS"))
(tu-eqf "kreisel-pfeil-params/guz"
'(((400.0 0.0 0.0) 90.0 -1.0) ((2700.0 0.0 0.0) 270.0 -1.0))
(kreisel-pfeil-params 400.0 2300.0 "GUZ"))
(tu-eqf "kreisel-pfeil-xskal/nil-ist-uzs" 1.0 (kreisel-pfeil-xskal nil))
(tu-eqf "eckrad-pfeil-params/guz"
'(((0.0 0.0 0.0) 90.0 -1.0)) (eckrad-pfeil-params "GUZ"))
;; KreiselInsert: Abstand + Rotation aus der Gummiband-Linie
(tu-eqf "kreisel-insert-richtung/ost"
'(2300.0 0.0) (kreisel-insert-richtung '(100.0 100.0 0.0) '(2400.0 100.0 0.0) 2300.0))
(tu-eqf "kreisel-insert-richtung/sued"
'(1500.0 270.0) (kreisel-insert-richtung '(0.0 0.0 0.0) '(0.0 -1500.0 0.0) 2300.0))
(tu-eqf "kreisel-insert-richtung/z-ignoriert"
'(1000.0 90.0) (kreisel-insert-richtung '(0.0 0.0 2000.0) '(0.0 1000.0 0.0) 2300.0))
(tu-eqf "kreisel-insert-richtung/enter-vorgabe"
'(2300.0 0.0) (kreisel-insert-richtung '(0.0 0.0 0.0) nil 2300.0))
;; Projektion eines Punktes auf eine Gerade
(tu-eqf "kreisel-project-point/lot"
'(0.0 0.0) (kreisel-project-point '(0.0 5.0) '(0.0 0.0) '(10.0 0.0)))
(tu-eqf "kreisel-project-point/mitte"
'(5.0 0.0) (kreisel-project-point '(5.0 5.0) '(0.0 0.0) '(10.0 0.0)))
;; Parallelitaet zweier Richtungsvektoren
(tu-true "kreisel-parallel-p/parallel" (kreisel-parallel-p '(1.0 0.0) '(2.0 0.0)))
(tu-nil "kreisel-parallel-p/senkrecht" (kreisel-parallel-p '(1.0 0.0) '(0.0 1.0)))
;; Ausrichtung <-> Index
(tu-eqf "kreisel-idx-to-rotation/0" 0.0 (kreisel-idx-to-rotation 0))
(tu-eqf "kreisel-idx-to-rotation/2" 90.0 (kreisel-idx-to-rotation 2))
(tu-eq "kreisel-rotation-to-idx/90" 2 (kreisel-rotation-to-idx 90.0))
(tu-eq "kreisel-rotation-to-idx/180" 1 (kreisel-rotation-to-idx 180.0))
;; Beschriftung mit/ohne eigenen Namen
(tu-eq "kreisel-label-text/name"
"KREISEL 3: Puffer STANDARD_2300" (kreisel-label-text 3 "Puffer" "STANDARD" 2300.0))
(tu-eq "kreisel-label-text/vorgabe-name"
"KREISEL 3: PIN_4000" (kreisel-label-text 3 "Kreisel3" "PIN" 4000.0))
(tu-eq "kreisel-label-text/leer"
"KREISEL 3: PIN_4000" (kreisel-label-text 3 "" "PIN" 4000.0))
;; Eckrad-Dialog: Eingaben -> (attribs . rotation)
(setq _e (eckrad-dialog-werte '(("NUMMER" . "3") ("HOEHE" . "0") ("DREHRICHTUNG" . "UZS"))
"Eck3" "2500" "-90" "1" "0" "1"))
(tu-eqf "eckrad-dialog-werte/rotation-normiert" 270.0 (cdr _e))
(tu-eq "eckrad-dialog-werte/hoehe" "2500" (cdr (assoc "HOEHE" (car _e))))
(tu-eq "eckrad-dialog-werte/nummer-bleibt" "3" (cdr (assoc "NUMMER" (car _e))))
(tu-eq "eckrad-dialog-werte/name" "Eck3" (cdr (assoc "Bezeichnung" (car _e))))
(tu-eq "eckrad-dialog-werte/guz" "GUZ" (cdr (assoc "DREHRICHTUNG" (car _e))))
(tu-eq "eckrad-dialog-werte/einzelmodul" "0" (cdr (assoc "GERUEST_EINZELMODUL" (car _e))))
(tu-eq "eckrad-dialog-werte/geruest-typ" (nth 1 *ssg-geruest-optionen*)
(cdr (assoc "GERUEST_TYP" (car _e))))
(tu-nil "eckrad-dialog-werte/hoehe-ungueltig"
(eckrad-dialog-werte nil "" "abc" "0" "0" "1" "2"))
(tu-nil "eckrad-dialog-werte/drehung-leer"
(eckrad-dialog-werte nil "" "2000" "" "0" "1" "2"))
)
;; ------------------------------------------------------------
;; TESTS: KreiselInsert.lsp - Beruehrpunkte/Weichen (kreisel-bp-*)
;; ------------------------------------------------------------
;; Element-Record kurz: (typ x y z rot abstand id)
(defun tu-bp-el (typ x y z rot abstand id)
(kreisel-bp-element typ (list x y) z rot abstand 400.0 id id id)
)
(defun tu-bp-arten (treffer)
(mapcar '(lambda (tr) (cdr (assoc "art" tr))) treffer)
)
(defun tu-tests-kreisel-bp ( / _els _erg _ber _kol)
(princ "\n[KreiselInsert/Beruehrpunkte]")
;; Hilfs-Kerne
(tu-eqf "kreisel-bp-abstand/attribut" 7715.0 (kreisel-bp-abstand "7715" "KREISEL_1_STANDARD_7715"))
(tu-eqf "kreisel-bp-abstand/blockname" 3469.0 (kreisel-bp-abstand nil "KREISEL_3_STANDARD_3469"))
(tu-eqf "kreisel-bp-naechste-punkte/kreuz"
'((5.0 0.0) (5.0 0.0))
(kreisel-bp-naechste-punkte '(0.0 0.0) '(10.0 0.0) '(5.0 -5.0) '(5.0 5.0)))
;; Die 11 Einfuegungen aus tests/testdata/schnittspunkte_kreisel.dxf
(setq _els
(list
(tu-bp-el "ECKRAD" 22405.42028816571 -4021.762548616969 5000.0 270.0 0.0 "E1")
(tu-bp-el "KREISEL" 20971.14247926632 -3221.762548616969 5000.0 0.0 7715.0 "K1")
(tu-bp-el "KREISEL" 22503.49142858727 -2821.762548616969 5000.0 90.0 9020.0 "K2")
(tu-bp-el "KREISEL" 27253.08134883916 -3621.762548616969 5000.0 270.0 3469.0 "K3")
(tu-bp-el "KREISEL" 22503.49142858727 6998.075803812235 5000.0 90.0 4746.0 "K4")
(tu-bp-el "KREISEL" 22405.42028816571 -4421.762548616969 5000.0 270.0 6147.0 "K5")
(tu-bp-el "KREISEL" 26853.08134883916 -6582.442351476258 5000.0 180.0 3248.0 "K6")
(tu-bp-el "KREISEL" 32541.84792939903 -5752.219206460449 2000.0 270.0 9200.0 "K7")
(tu-bp-el "KREISEL" 32941.84792939903 -7662.266486416901 2000.0 0.0 3637.0 "K8a")
(tu-bp-el "KREISEL" 32941.84792939903 -11185.64734962363 2000.0 0.0 3637.0 "K8b")
(tu-bp-el "ECKRAD" 20571.14247926632 -3221.762548616969 5000.0 270.0 0.0 "E1b")))
(setq _erg (kreisel-bp-berechnen _els 1.0 1.0)
_ber (car _erg)
_kol (cadr _erg))
(tu-eq "kreisel-bp/dxf-beruehrungen" 10 (length _ber))
(tu-eq "kreisel-bp/dxf-kollisionen" 0 (length _kol))
(tu-eq "kreisel-bp/dxf-kreis-kreis" 3
(length (vl-remove-if-not '(lambda (a) (= a "Kreis/Kreis")) (tu-bp-arten _ber))))
(tu-eq "kreisel-bp/dxf-paare"
'(("E1" "K1") ("E1" "K5") ("K1" "K2") ("K1" "K3") ("K1" "E1b") ("K2" "K4")
("K3" "K6") ("K5" "K6") ("K7" "K8a") ("K7" "K8b"))
(mapcar '(lambda (tr) (list (cdr (assoc "id" (cdr (assoc "a" tr))))
(cdr (assoc "id" (cdr (assoc "b" tr))))))
_ber))
;; K2 (AN8) steht auf dem oberen Laufprofil von K1
(tu-eqf "kreisel-bp/dxf-punkt-k1-k2"
(list 22503.49142858727 -2821.762548616969)
(cdr (assoc "p" (nth 2 _ber))))
(tu-eq "kreisel-bp/dxf-achse-von-k1-k2" "K2" (cdr (assoc "achse_von" (nth 2 _ber))))
;; Unterschiedliche Hoehe -> kein Kontakt
(tu-eq "kreisel-bp/hoehe"
'(nil nil)
(kreisel-bp-berechnen (list (tu-bp-el "ECKRAD" 0.0 0.0 0.0 0.0 0.0 "A")
(tu-bp-el "ECKRAD" 800.0 0.0 500.0 0.0 0.0 "B"))
1.0 1.0))
;; Zwei Eckraeder Rad an Rad -> eine Weiche in der Mitte
(setq _ber (car (kreisel-bp-berechnen (list (tu-bp-el "ECKRAD" 0.0 0.0 0.0 0.0 0.0 "A")
(tu-bp-el "ECKRAD" 800.0 0.0 0.0 0.0 0.0 "B"))
1.0 1.0)))
(tu-eq "kreisel-bp/eckraeder-art" '("Kreis/Kreis") (tu-bp-arten _ber))
(tu-eqf "kreisel-bp/eckraeder-punkt" '(400.0 0.0) (cdr (assoc "p" (car _ber))))
;; Spalt groesser als Toleranz -> nichts
(tu-eq "kreisel-bp/spalt"
'(nil nil)
(kreisel-bp-berechnen (list (tu-bp-el "ECKRAD" 0.0 0.0 0.0 0.0 0.0 "A")
(tu-bp-el "ECKRAD" 805.0 0.0 0.0 0.0 0.0 "B"))
1.0 1.0))
;; Laufprofile kreuzen sich -> Kollision, keine Weiche
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 1000.0 -1500.0 0.0 90.0 2000.0 "B"))
1.0 1.0))
(tu-nil "kreisel-bp/kreuzung-keine-weiche" (car _erg))
(tu-eq "kreisel-bp/kreuzung-kollision" '("Ueberschneidung") (tu-bp-arten (cadr _erg)))
;; Kreisel Seite an Seite (Profile aufeinander) -> Kollision, keine Weiche
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 500.0 800.0 0.0 0.0 2000.0 "B"))
1.0 1.0))
(tu-nil "kreisel-bp/parallel-keine-weiche" (car _erg))
(tu-eq "kreisel-bp/parallel-kollision" '("Tangente/Tangente") (tu-bp-arten (cadr _erg)))
;; Eckrad an der Flanke eines Kreiselrades -> Weiche (freie Seite)
(setq _ber (car (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "ECKRAD" 400.0 800.0 0.0 0.0 0.0 "B"))
1.0 1.0)))
(tu-eq "kreisel-bp/flanke-eckrad" 1 (length _ber))
;; Kreisel seitlich versetzt Ende an Ende (Raeder Flanke an Flanke, aber in
;; Gegenrichtung) -> Weiche, keine Seite-an-Seite-Kollision
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 2000.0 800.0 0.0 0.0 2000.0 "B"))
1.0 1.0))
(tu-eq "kreisel-bp/ende-an-ende-art" '("Kreis/Kreis") (tu-bp-arten (car _erg)))
(tu-eqf "kreisel-bp/ende-an-ende-punkt" '(2400.0 400.0) (cdr (assoc "p" (car (car _erg)))))
(tu-nil "kreisel-bp/ende-an-ende-keine-kollision" (cadr _erg))
;; Gleich ausgerichtete Raeder Flanke an Flanke (echtes Seite an Seite) -> keine Weiche
(setq _erg (kreisel-bp-berechnen (list (tu-bp-el "KREISEL" 0.0 0.0 0.0 0.0 2000.0 "A")
(tu-bp-el "KREISEL" 0.0 800.0 0.0 0.0 2000.0 "B"))
1.0 1.0))
(tu-nil "kreisel-bp/seite-an-seite-keine-weiche" (car _erg))
;; results/test.dxf (E3/C7): Kreisel 2/3/4 Ende an Ende (0.9 mm Ueberlappung bzw.
;; 5.5 mm), Kreisel 8 vor dem Profil von Kreisel 9 (2.6 mm Spalt) - mit 10 mm
;; Toleranz drei Weichen
(setq _erg (kreisel-bp-berechnen
(list (tu-bp-el "KREISEL" 4940.03 -7603.25 2000.0 90.0 4500.0 "2")
(tu-bp-el "KREISEL" 5739.13 -12898.65 2000.0 90.0 5296.0 "3")
(tu-bp-el "KREISEL" 6533.6 -7603.44 2000.0 90.0 7889.0 "4")
(tu-bp-el "KREISEL" -61.76 -974.08 2000.0 90.0 4000.0 "9")
(tu-bp-el "KREISEL" 340.85 505.79 2000.0 0.0 3400.0 "8"))
10.0 1.0))
(tu-eq "kreisel-bp/test-dxf-paare"
'(("2" "3") ("3" "4") ("9" "8"))
(mapcar '(lambda (tr) (list (cdr (assoc "id" (cdr (assoc "a" tr))))
(cdr (assoc "id" (cdr (assoc "b" tr))))))
(car _erg)))
(tu-nil "kreisel-bp/test-dxf-keine-kollision" (cadr _erg))
)
;; ------------------------------------------------------------
;; TESTS: ssg_ks_insert.lsp - Sepliste-Serialisierung
;; ------------------------------------------------------------
(defun tu-tests-sepliste ()
(princ "\n[ssg_ks_insert/sepliste]")
;; ssg-sepliste-chunk-string: Stuecke <= n, nichts verloren
(tu-eq "ssg-sepliste-chunk-string/glatt" '("ab" "cd") (ssg-sepliste-chunk-string "abcd" 2))
(tu-eq "ssg-sepliste-chunk-string/rest" '("ab" "cd" "e") (ssg-sepliste-chunk-string "abcde" 2))
(tu-eq "ssg-sepliste-chunk-string/kuerzer" '("abc") (ssg-sepliste-chunk-string "abc" 10))
;; ssg-sepliste-split-feld: Trenner-Aufteilung, inkl. leeres Feld
(tu-eq "ssg-sepliste-split-feld/normal" '("SEP" "1" "10.00" "20.00")
(ssg-sepliste-split-feld "SEP:1:10.00:20.00" ":"))
;; ssg-sepliste-fmt-koord: GENAU 2 Nachkommastellen, DIMZIN-unabhaengig.
;; Ersetzt rtos (das bei DIMZIN=8 abschliessende Nullen verschluckt und die
;; XDATA-Serialisierung zeichnungsprofilabhaengig gemacht hat).
(tu-eq "sepliste-fmt/ganz" "10.00" (ssg-sepliste-fmt-koord 10.0))
(tu-eq "sepliste-fmt/eine-stelle" "30.50" (ssg-sepliste-fmt-koord 30.5))
(tu-eq "sepliste-fmt/rundung-ab" "5.01" (ssg-sepliste-fmt-koord 5.007))
(tu-eq "sepliste-fmt/uebertrag" "10.00" (ssg-sepliste-fmt-koord 9.999))
(tu-eq "sepliste-fmt/negativ" "-5.00" (ssg-sepliste-fmt-koord -5.0))
(tu-eq "sepliste-fmt/negativ-rund" "-5.01" (ssg-sepliste-fmt-koord -5.007))
(tu-eq "sepliste-fmt/null" "0.00" (ssg-sepliste-fmt-koord 0.0))
;; ssg-sepliste->string: Serialisierung eines Eintrags
(tu-eq "ssg-sepliste->string/ein-eintrag"
"SEP:1:10.00:20.00"
(ssg-sepliste->string '(("SEP" 1 10.0 20.0))))
(tu-eq "ssg-sepliste->string/mehrere"
"SEP:1:10.00:20.00,AS:2:30.00:40.00"
(ssg-sepliste->string '(("SEP" 1 10.0 20.0) ("AS" 2 30.0 40.0))))
;; ssg-sepliste-string->liste: Gegenstueck zu ssg-sepliste->string
(tu-eq "ssg-sepliste-string->liste/leer" nil (ssg-sepliste-string->liste ""))
(tu-eq "ssg-sepliste-string->liste/ein-eintrag"
'(("SEP" 1 10.0 20.0))
(ssg-sepliste-string->liste "SEP:1:10.00:20.00"))
;; Roundtrip ->string->liste: entscheidend, da der Export genau diesen
;; Weg (XDATA schreiben/lesen) fuer die Separator-Reihenfolge nutzt.
(setq _sep '(("SEP" 1 10.0 20.0) ("AS" 2 30.5 40.5) ("ES" 3 -5.0 0.0)))
(tu-eqf "sepliste-roundtrip/mehrere-typen"
_sep
(ssg-sepliste-string->liste (ssg-sepliste->string _sep)))
)
;; ------------------------------------------------------------
;; TESTS: ssg_core.lsp - rekursiver JSON-Parser + ssg-join
;; ------------------------------------------------------------
(defun tu-tests-json ( / _p _datei _daten _bg _var _anb)
(princ "\n[ssg_core/json]")
;; ssg-join
(tu-eq "ssg-join/leer" "" (ssg-join '() ","))
(tu-eq "ssg-join/eins" "a" (ssg-join '("a") ","))
(tu-eq "ssg-join/drei" "a,b,c" (ssg-join '("a" "b" "c") ","))
(tu-eq "ssg-join/plus" "a + b" (ssg-join '("a" "b") " + "))
;; Skalare und flaches Objekt
(tu-eq "json/objekt-flach" '(("a" . 1)) (ssg-json-parse "{\"a\": 1}"))
(tu-eq "json/zwei-keys" '(("a" . 1) ("b" . 2))
(ssg-json-parse "{\"a\": 1, \"b\": 2}"))
(tu-eq "json/string" "hallo" (ssg-json-get (ssg-json-parse "{\"a\": \"hallo\"}") "a"))
(tu-eq "json/int" 6000 (ssg-json-get (ssg-json-parse "{\"a\": 6000}") "a"))
(tu-eqf "json/real" 1.5 (ssg-json-get (ssg-json-parse "{\"a\": 1.5}") "a"))
(tu-eq "json/true" T (ssg-json-get (ssg-json-parse "{\"a\": true}") "a"))
(tu-eq "json/false" nil (ssg-json-get (ssg-json-parse "{\"a\": false}") "a"))
(tu-eq "json/null" nil (ssg-json-get (ssg-json-parse "{\"a\": null}") "a"))
;; Verschachtelung - genau das, was die alten Zeilen-Parser nicht koennen
(tu-eq "json/objekt-verschachtelt" '(("a" ("b" . 2)))
(ssg-json-parse "{\"a\": {\"b\": 2}}"))
(tu-eq "json/array" '(("a" 1 2 3))
(ssg-json-parse "{\"a\": [1, 2, 3]}"))
(tu-eq "json/array-objekte" '(("a" (("b" . 1)) (("b" . 2))))
(ssg-json-parse "{\"a\": [{\"b\": 1}, {\"b\": 2}]}"))
(tu-eq "json/array-leer" '(("a")) (ssg-json-parse "{\"a\": []}"))
;; Mehrzeilig (alte Parser verlangen Arrays in EINER Zeile)
(tu-eq "json/mehrzeilig" '(("a" "x" "y"))
(ssg-json-parse "{\n \"a\": [\n \"x\",\n \"y\"\n ]\n}"))
;; Maskiertes Anfuehrungszeichen und Komma im String - beides kommt in den
;; Geruest-Artikelbezeichnungen real vor ("ROHR R 1\" 33,7 x 2,6")
(tu-eq "json/escape-quote" "R 1\" x"
(ssg-json-get (ssg-json-parse "{\"a\": \"R 1\\\" x\"}") "a"))
(tu-eq "json/komma-im-string" "33,7 x 2,6"
(ssg-json-get (ssg-json-parse "{\"a\": \"33,7 x 2,6\"}") "a"))
(tu-eq "json/escape-backslash" "a\\b"
(ssg-json-get (ssg-json-parse "{\"a\": \"a\\\\b\"}") "a"))
(tu-eq "json/escape-newline" (chr 10)
(ssg-json-get (ssg-json-parse "{\"a\": \"\\n\"}") "a"))
;; ssg-json-escape: Gegenstueck zum Parser
(tu-eq "json-escape/quote" "a\\\"b" (ssg-json-escape "a\"b"))
(tu-eq "json-escape/backslash" "a\\\\b" (ssg-json-escape "a\\b"))
(tu-eq "json-escape/newline" "a\\nb" (ssg-json-escape (strcat "a" (chr 10) "b")))
(tu-eq "json-escape/leer" "" (ssg-json-escape nil))
;; Rundlauf: maskieren -> parsen ergibt den Originaltext zurueck
(tu-eq "json-escape/rundlauf" "ROHRKLAMMER 1\" KPL. VERTIKAL"
(ssg-json-get
(ssg-json-parse
(strcat "{\"a\": \""
(ssg-json-escape "ROHRKLAMMER 1\" KPL. VERTIKAL") "\"}"))
"a"))
;; Echte Datendatei: der eigentliche Praxisfall
(setq _datei (strcat (getenv "DXFMAKRO") "/data/json/geruest.json"))
(if (findfile _datei)
(progn
(setq _daten (ssg-json-laden _datei))
;; Drei Bereiche: Rohrabhaenger, Saeulen (1 und 2 Zoll zusammengefuehrt),
;; Wandbefestigung. Die Traeger liegen in geruest_traeger.json.
(tu-eq "json/geruest-baugruppen" 3 (length _daten))
;; Baugruppe ueber das ASCII-Feld "id" finden (aeusserer Schluessel
;; traegt Umlaute bzw. Anfuehrungszeichen)
(setq _bg nil)
(foreach _e _daten
(if (and (null _bg) (= (ssg-json-get (cdr _e) "id") "Rohrabhaenger"))
(setq _bg (cdr _e))))
(tu-eq "json/geruest-id-gefunden" T (if _bg T nil))
(if _bg
(progn
(setq _var (ssg-json-get _bg "geometrie_varianten"))
(setq _anb (ssg-json-get _bg "anbaugruppen"))
(tu-eq "json/geruest-varianten" 4 (length _var))
(tu-eq "json/geruest-teileart" "Geruest Rohrabhaenger"
(ssg-json-get _bg "teileart"))
(tu-eq "json/geruest-dummy" "Rohrabhaenger_dummy.dwg"
(ssg-json-get _bg "dummy"))
;; Sivas-ID als Zahl geparst, Laengengrenze aus dem attribute-Block.
;; Die Keys unter "attribute" sind die Block-Attribut-Tags und darum
;; GROSS geschrieben (ssg-json-get unterscheidet Gross/Klein).
(tu-eq "json/geruest-sivas" 821006026
(ssg-json-get (car (ssg-json-get (car _var) "teile")) "sivas_id"))
(tu-eq "json/geruest-max" 6000
(ssg-json-get (ssg-json-get (ssg-json-get _bg "attribute") "LAENGE") "max"))
(tu-eq "json/geruest-farboptionen" '("RAL7035" "RAL7030")
(ssg-json-get (ssg-json-get (ssg-json-get _bg "attribute") "TEILEFARBE")
"optionen"))
)
)
)
(tu-record nil "json/geruest-datei" (strcat "nicht gefunden: " _datei))
)
)
;; ------------------------------------------------------------
;; TESTS: GeruestInsert.lsp - reine Hilfsfunktionen
;; ------------------------------------------------------------
;; Anzahl der Artikel (Blatt-Eintraege, Gruppen "teile" rekursiv) ohne
;; sivas_id oder ohne farbig-Schluessel. assoc statt ssg-json-get: false
;; wird zu nil geparst, der Schluessel selbst muss aber vorhanden sein.
(defun tu-geruest-artikel-unvollstaendig (eintraege / n teile)
(setq n 0)
(foreach e eintraege
(setq teile (ssg-json-get e "teile"))
(if teile
(setq n (+ n (tu-geruest-artikel-unvollstaendig teile)))
(if (or (null (ssg-json-get e "sivas_id"))
(null (assoc "farbig" e)))
(setq n (1+ n)))
)
)
n
)
(defun tu-tests-geruest ( / _eintrag _gruppe _teile _konfig _rec _pfad _f
_zurueck _bgtest _saeulen _vmq _alt _fs)
(princ "\n[GeruestInsert]")
;; GeruestInsert ist ein lazy Feature-Modul (nicht in der Core-Ladeliste).
;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur
;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur).
(if (null (atoms-family 1 '("GERUEST-ARTIKELNUMMERN")))
(tu-record nil "geruest/modul" "GeruestInsert.lsp nicht geladen")
(progn
(tu-eq "geruest-id-string/int" "821006026" (geruest-id-string 821006026))
(tu-eq "geruest-id-string/str" "0_B10071" (geruest-id-string "0_B10071"))
(tu-eq "geruest-id-string/nil" nil (geruest-id-string nil))
;; Einzelteil mit stueckzahl 2 -> Artikelnummer zweimal (ARTINR-Regel)
(setq _eintrag (ssg-json-parse
"{\"artikel\": \"X\", \"sivas_id\": 825002019, \"stueckzahl\": 2}"))
(tu-eq "geruest-artnr/stueckzahl2" '("825002019" "825002019")
(geruest-artikelnummern _eintrag))
(tu-eq "geruest-name/artikel" "X" (geruest-eintrag-name _eintrag))
;; Benannte Gruppe -> teile rekursiv aufloesen, Mengen beachten
(setq _gruppe (ssg-json-parse
(strcat "{\"name\": \"Schraubenset\", \"teile\": ["
"{\"artikel\": \"A\", \"sivas_id\": 111, \"stueckzahl\": 1},"
"{\"artikel\": \"B\", \"sivas_id\": 222, \"stueckzahl\": 2}]}")))
(tu-eq "geruest-artnr/gruppe" '("111" "222" "222")
(geruest-artikelnummern _gruppe))
(tu-eq "geruest-name/gruppe" "Schraubenset" (geruest-eintrag-name _gruppe))
;; Fehlendes stueckzahl-Feld -> 1
(tu-eq "geruest-artnr/ohne-stueckzahl" '("333")
(geruest-artikelnummern
(ssg-json-parse "{\"artikel\": \"C\", \"sivas_id\": 333}")))
;; --- Teile-DWGs (visuelle Rueckmeldung im Block) ---
(tu-eq "geruest-eindeutig/dupl" '("1" "2" "3")
(geruest-eindeutig '("1" "2" "1" "3" "2")))
(tu-eq "geruest-eindeutig/leer" nil (geruest-eindeutig nil))
;; Artikelnummer ohne DWG -> still uebergangen
(tu-eq "geruest-teile-dwgs/fehlt" nil
(geruest-teile-dwgs '("999999999")))
;; Vorhandene DWG (liegt im Repo) -> genau ein Pfad, auch bei Mehrfach-
;; Stueckzahl und gemischt mit einer fehlenden Nummer
(setq _pfad (geruest-dummy-pfad "825002019.dwg"))
(if (and _pfad (findfile _pfad))
(tu-eq "geruest-teile-dwgs/vorhanden" (list _pfad)
(geruest-teile-dwgs '("825002019" "999999999" "825002019")))
)
;; --- Anzahl-Vorgabe (Dialogfeld) vs. stueckzahl (wirklich geschrieben) ---
(tu-eq "geruest-anzahl-vorgabe/gruppe" 2
(geruest-anzahl-vorgabe (ssg-json-parse
"{\"name\": \"G\", \"anzahl_vorgabe\": 2, \"teile\": [{\"sivas_id\": 1, \"stueckzahl\": 1}]}")))
;; stueckzahl ist KEINE Vorgabe fuer das Dialogfeld
(tu-eq "geruest-anzahl-vorgabe/stueckzahl-zaehlt-nicht" 1
(geruest-anzahl-vorgabe (ssg-json-parse "{\"sivas_id\": 1, \"stueckzahl\": 3}")))
(tu-eq "geruest-anzahl-vorgabe/ohne" 1
(geruest-anzahl-vorgabe (ssg-json-parse "{\"name\": \"G\", \"teile\": []}")))
;; anzahl_vorgabe bestimmt nur die Vorbelegung, nicht den Satzinhalt:
;; 3 Saetze a (1 Schraube + 1 Duebel) = 6 Nummern
(tu-eq "geruest-artikelnummern-n/anzahl-vorgabe" '("1" "2" "1" "2" "1" "2")
(geruest-artikelnummern-n (ssg-json-parse
"{\"name\": \"G\", \"anzahl_vorgabe\": 2, \"teile\": [{\"sivas_id\": 1, \"stueckzahl\": 1}, {\"sivas_id\": 2, \"stueckzahl\": 1}]}")
3))
;; Einzelteil-Anbauteil: Anzahl x stueckzahl
(tu-eq "geruest-artikelnummern-n/einzelteil-stueckzahl" '("7" "7" "7" "7")
(geruest-artikelnummern-n (ssg-json-parse
"{\"artikel\": \"X\", \"sivas_id\": 7, \"stueckzahl\": 2, \"anzahl_vorgabe\": 5}")
2))
;; Dummy, der zugleich Teile-DWG ist, faellt aus der Teileliste
(tu-eq "geruest-ohne-pfad/entfernt" '(("b/2.dwg" . 90.0))
(geruest-ohne-pfad "A/1.DWG" '(("a/1.dwg" . 0.0) ("b/2.dwg" . 90.0))))
(tu-eq "geruest-ohne-pfad/nil" '(("a/1.dwg" . 0.0))
(geruest-ohne-pfad nil '(("a/1.dwg" . 0.0))))
;; Dummy-Wahl: Variante gewinnt, fehlende Varianten-DWG -> Baugruppe
(setq _pfad (geruest-dummy-pfad "821006036.dwg"))
(if (and _pfad (findfile _pfad))
(tu-eq "geruest-dummy-wahl/variante" "821006036.dwg"
(car (geruest-dummy-wahl
(ssg-json-parse "{\"dummy\": \"821006036.dwg\"}")
(ssg-json-parse "{\"dummy\": \"basis.dwg\"}"))))
)
(tu-eq "geruest-dummy-wahl/fehlt" "basis.dwg"
(car (geruest-dummy-wahl
(ssg-json-parse "{\"dummy\": \"gibtsnicht_999.dwg\"}")
(ssg-json-parse "{\"dummy\": \"basis.dwg\"}"))))
(tu-eq "geruest-dummy-wahl/ohne" "basis.dwg"
(car (geruest-dummy-wahl
(ssg-json-parse "{\"name\": \"X\"}")
(ssg-json-parse "{\"dummy\": \"basis.dwg\"}"))))
;; --- Mengenfeld ---
(tu-eq "geruest-zahl-p/ziffern" T (geruest-zahl-p "12"))
(tu-eq "geruest-zahl-p/text" nil (geruest-zahl-p "1a"))
(tu-eq "geruest-zahl-p/leer" nil (geruest-zahl-p ""))
;; Leeres Feld uebernimmt die JSON-Vorgabe, ungueltiges liefert nil
(tu-eq "geruest-anzahl-wert/leer" 2 (geruest-anzahl-wert "" 2))
(tu-eq "geruest-anzahl-wert/zahl" 5 (geruest-anzahl-wert "5" 2))
(tu-eq "geruest-anzahl-wert/null" nil (geruest-anzahl-wert "0" 2))
(tu-eq "geruest-anzahl-wert/text" nil (geruest-anzahl-wert "abc" 2))
(tu-eq "geruest-anzahl-wert/negativ" nil (geruest-anzahl-wert "-3" 2))
;; --- Einzelteil: Anzahl (Dialog) x stueckzahl (JSON, hier 2) ---
(tu-eq "geruest-artnr-n/einzelteil" 6
(length (geruest-artikelnummern-n _eintrag 3)))
;; --- Gruppe: ganzes Set n-mal, Mengen INNERHALB bleiben erhalten ---
(tu-eq "geruest-artnr-n/gruppe" '("111" "222" "222" "111" "222" "222")
(geruest-artikelnummern-n _gruppe 2))
;; --- farbig-Flag / TEILEFARBE-Liste parallel zu ARTINR ---
;; _eintrag hat kein "farbig" -> nicht farbig
(tu-eq "geruest-paare/ohne-flag" '(("825002019") ("825002019"))
(geruest-teile-paare _eintrag nil))
(tu-eq "geruest-paare/farbig" '(("444" . T))
(geruest-teile-paare
(ssg-json-parse "{\"artikel\": \"D\", \"sivas_id\": 444, \"farbig\": true}")
nil))
(tu-eq "geruest-paare/false" '(("555"))
(geruest-teile-paare
(ssg-json-parse "{\"artikel\": \"E\", \"sivas_id\": 555, \"farbig\": false}")
nil))
;; Gruppe mit farbig vererbt an alle Teile, Mengen bleiben erhalten
(setq _teile (ssg-json-parse
(strcat "{\"name\": \"Set\", \"farbig\": true, \"teile\": ["
"{\"artikel\": \"A\", \"sivas_id\": 111},"
"{\"artikel\": \"B\", \"sivas_id\": 222, \"stueckzahl\": 2}]}")))
(tu-eq "geruest-paare/gruppe-erbt" '(("111" . T) ("222" . T) ("222" . T))
(geruest-teile-paare _teile nil))
(tu-eq "geruest-paare-n/gruppe" 6 (length (geruest-teile-paare-n _teile 2)))
(tu-eq "geruest-paare-n/einzelteil-farbig" '(("444" . T) ("444" . T))
(geruest-teile-paare-n
(ssg-json-parse "{\"artikel\": \"D\", \"sivas_id\": 444, \"farbig\": true}")
2))
(tu-eq "geruest-farbliste" '("" "RAL7030" "")
(geruest-farbliste '(("1") ("2" . T) ("3")) "RAL7030"))
(tu-eq "geruest-farbliste/join" ",RAL7030,"
(ssg-join (geruest-farbliste '(("1") ("2" . T) ("3")) "RAL7030") ","))
;; --- DCL-Label: Anfuehrungszeichen wuerde die Datei zerstoeren ---
(tu-eq "geruest-dcl-label/quote" "ROHRKLAMMER 1'' KPL. VERTIKAL"
(geruest-dcl-label "ROHRKLAMMER 1\" KPL. VERTIKAL"))
(tu-eq "geruest-dcl-label/ohne" "WINKEL 60X60X6X60"
(geruest-dcl-label "WINKEL 60X60X6X60"))
;; --- Hilfslisten ---
(tu-eq "geruest-nil-liste" '(nil nil nil) (geruest-nil-liste 3))
(tu-eq "geruest-liste-setzen" '(nil 7 nil)
(geruest-liste-setzen (geruest-nil-liste 3) 1 7))
(tu-eq "geruest-alist-setzen/neu" '(("a" . 1))
(geruest-alist-setzen nil "a" 1))
(tu-eq "geruest-alist-setzen/ersetzt" '(("a" . 2))
(geruest-alist-setzen '(("a" . 1)) "a" 2))
(tu-eq "geruest-zahl-string/int" "2000" (geruest-zahl-string 2000))
(tu-eq "geruest-zahl-string/leer" "" (geruest-zahl-string nil))
;; --- Konfiguration auf Anbauteile abbilden ---
(setq _teile (list _eintrag _gruppe))
(tu-eq "geruest-name-index/treffer" 1
(geruest-name-index "Schraubenset" _teile))
(tu-eq "geruest-name-index/fehlt" nil
(geruest-name-index "gibt es nicht" _teile))
;; Bekanntes Teil wird uebernommen, unbekanntes uebersprungen (nicht
;; die ganze Konfiguration verworfen)
(setq _konfig (ssg-json-parse
(strcat "{\"name\": \"K1\", \"oben\": ["
"{\"artikel\": \"Schraubenset\", \"anzahl\": 3},"
"{\"artikel\": \"unbekannt\", \"anzahl\": 1}]}")))
(tu-eq "geruest-konfig-position" '(nil 3)
(geruest-konfig-position _konfig "oben" _teile nil))
;; --- anbaugruppen: befestigung / sonstiges ---
(setq _bgtest (ssg-json-parse
(strcat "{\"anbaugruppen\": {\"befestigung\": [{\"artikel\": \"K\"}],"
" \"sonstiges\": [{\"artikel\": \"H1\"}, {\"artikel\": \"H2\"}]}}")))
(tu-eq "geruest-anbau-liste/befestigung" 1
(length (geruest-anbau-liste _bgtest "befestigung")))
(tu-eq "geruest-anbau-liste/sonstiges" '("H1" "H2")
(mapcar 'geruest-eintrag-name (geruest-anbau-liste _bgtest "sonstiges")))
;; altes flaches Array gilt als befestigung
(setq _rec (ssg-json-parse "{\"anbaugruppen\": [{\"artikel\": \"A\"}, {\"artikel\": \"B\"}]}"))
(tu-eq "geruest-anbau-liste/flach" 2 (length (geruest-anbau-liste _rec "befestigung")))
(tu-nil "geruest-anbau-liste/flach-sonstiges" (geruest-anbau-liste _rec "sonstiges"))
(tu-nil "geruest-anbau-liste/leer"
(geruest-anbau-liste
(ssg-json-parse "{\"anbaugruppen\": {\"befestigung\": [], \"sonstiges\": []}}")
"sonstiges"))
(tu-nil "geruest-anbau-liste/fehlt"
(geruest-anbau-liste (ssg-json-parse "{\"id\": \"X\"}") "befestigung"))
(tu-eq "geruest-dlg-standard/teile" '(("0" . "1") ("0" . "1"))
(geruest-dlg-standard (geruest-anbau-liste _bgtest "sonstiges")))
(tu-eq "geruest-mengen-addieren" '(nil 3 2 5)
(geruest-mengen-addieren '(nil 1 nil 2) '(nil 2 2 3)))
;; Alte Konfiguration mit Haltearm unter "oben": landet in sonstiges
;; (Mengen addiert), oben meldet ihn nicht als unbekannt
(setq _konfig (ssg-json-parse
(strcat "{\"name\": \"Alt\","
" \"oben\": [{\"artikel\": \"K\", \"anzahl\": 2}, {\"artikel\": \"H2\", \"anzahl\": 1}],"
" \"unten\": [{\"artikel\": \"H2\", \"anzahl\": 2}],"
" \"sonstiges\": [{\"artikel\": \"H1\", \"anzahl\": 4}]}")))
(tu-eq "geruest-konfig-position/ausweich" '(2)
(geruest-konfig-position _konfig "oben"
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
;; --- Winkel Platte: Basis ungedreht, Anbauteile gedreht, kein Doppel ---
(tu-eq "geruest-teile-dwgs-rot/90" '(("b.dwg" . 0.0) ("a.dwg" . 90.0))
(geruest-teile-dwgs-rot '("b.dwg") '("b.dwg" "a.dwg") 90))
(tu-eq "geruest-teile-dwgs-rot/0" '(("a.dwg" . 0.0))
(geruest-teile-dwgs-rot nil '("a.dwg") 0))
(tu-eq "geruest-rest-liste" '(3 4) (geruest-rest-liste '(1 2 3 4) 2))
(tu-eq "geruest-winkel-aus-index/90" 90 (geruest-winkel-aus-index "1"))
(tu-eq "geruest-winkel-aus-index/leer" 0 (geruest-winkel-aus-index ""))
(tu-eq "geruest-winkel-index/90" "1" (geruest-winkel-index 90))
(tu-eq "geruest-winkel-index/fehlt" "0" (geruest-winkel-index nil))
;; --- Radiobuttons der Varianten: Key "v<i>" <-> Index ---
(tu-eq "geruest-radio-key" "v3" (geruest-radio-key 3))
(tu-eq "geruest-radio-index" 3 (geruest-radio-index "v3"))
(tu-eq "geruest-radio-index/leer" 0 (geruest-radio-index ""))
(tu-eq "geruest-radio-index/nil" 0 (geruest-radio-index nil))
(tu-eq "geruest-indizes" '(0 1 2) (geruest-indizes 3))
(tu-nil "geruest-indizes/0" (geruest-indizes 0))
(tu-eq "geruest-dcl-varianten-zeilen"
'(" : radio_button { key = \"v1\"; label = \"B 1''\"; }")
(geruest-dcl-varianten-zeilen
(list '(("name" . "A")) '(("name" . "B 1\""))) '(1)))
;; Variante mit Teilen: Artikelnummern in Klammern, jede nur einmal
(tu-eq "geruest-varianten-label/nummern" "R 2\" (111, 222)"
(geruest-varianten-label
(ssg-json-parse
(strcat "{\"name\": \"R 2\\\"\", \"teile\": ["
"{\"artikel\": \"A\", \"sivas_id\": 111},"
"{\"artikel\": \"B\", \"sivas_id\": 222, \"stueckzahl\": 2}]}"))))
(tu-eq "geruest-varianten-label/ohne" "A"
(geruest-varianten-label '(("name" . "A"))))
;; --- Gesperrte Varianten ("disabled": true) ---
(setq _rec (list '(("name" . "A") ("disabled" . T))
'(("name" . "B"))
'(("name" . "C") ("disabled" . T))))
(tu-true "geruest-variante-gesperrt-p/ja" (geruest-variante-gesperrt-p (nth 0 _rec)))
(tu-nil "geruest-variante-gesperrt-p/nein" (geruest-variante-gesperrt-p (nth 1 _rec)))
(tu-eq "geruest-erste-freie-variante" 1 (geruest-erste-freie-variante _rec))
(tu-eq "geruest-erste-freie-variante/alle-gesperrt" 0
(geruest-erste-freie-variante (list '(("disabled" . T)))))
(tu-eq "geruest-variante-waehlbar/frei" 1 (geruest-variante-waehlbar _rec 1))
(tu-eq "geruest-variante-waehlbar/gesperrt" 1 (geruest-variante-waehlbar _rec 2))
(tu-eq "geruest-variante-waehlbar/zu-gross" 1 (geruest-variante-waehlbar _rec 7))
;; Ersetzungen: ohne Teile entfallen die Bloecke (leerer Cluster)
(setq _rec (geruest-dcl-ersetzungen "Saeulen" nil nil
(list '(("name" . "A")))))
(tu-nil "geruest-dcl-ersetzungen/ohne-befestigung"
(cdr (assoc "BEFESTIGUNG" _rec)))
(tu-nil "geruest-dcl-ersetzungen/ohne-sonstiges"
(cdr (assoc "SONSTIGES" _rec)))
(tu-eq "geruest-dcl-ersetzungen/varianten" 1
(length (cdr (assoc "VARIANTEN" _rec))))
;; --- Geaenderte Konfiguration: Vergleich ohne Namen ---
(tu-true "geruest-record-gleich-p/name"
(geruest-record-gleich-p '(("name" . "A") ("laenge" . "100"))
'(("name" . "B") ("laenge" . "100"))))
(tu-nil "geruest-record-gleich-p/geaendert"
(geruest-record-gleich-p '(("name" . "A") ("laenge" . "100"))
'(("name" . "A") ("laenge" . "200"))))
;; Eigene Konfiguration gewinnt vor gleichnamiger Bibliothek; nur eine
;; eigene liefert eine Namensvorgabe (Ueberspeichern)
(setq _alt *geruest-konfig-liste*)
(setq *geruest-konfig-liste*
(list (cons nil '(("name" . "K"))) (cons T '(("name" . "K")))
(cons nil '(("name" . "L")))))
(tu-eq "geruest-konfig-index/eigene-zuerst" 2 (geruest-konfig-index "K"))
(tu-eq "geruest-konfig-index/bibliothek" 3 (geruest-konfig-index "L"))
(tu-eq "geruest-konfig-name-vorgabe/eigene" "K" (geruest-konfig-name-vorgabe 2))
(tu-nil "geruest-konfig-name-vorgabe/bibliothek" (geruest-konfig-name-vorgabe 1))
(tu-nil "geruest-konfig-name-vorgabe/keine" (geruest-konfig-name-vorgabe 0))
(setq *geruest-konfig-liste* _alt)
(tu-eq "geruest-konfig-sonstiges/umhaengen" '(4 3)
(geruest-konfig-sonstiges _konfig
(geruest-anbau-liste _bgtest "sonstiges")
(geruest-anbau-liste _bgtest "befestigung")))
;; Befestigung = Gesamtanzahl: neues Feld "befestigung", altes oben +
;; unten summiert; der Haltearm unter "oben" wird hier still uebergangen
(tu-eq "geruest-konfig-befestigung/alt" '(2)
(geruest-konfig-befestigung _konfig
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
(tu-eq "geruest-konfig-befestigung/oben-unten" '(5)
(geruest-konfig-befestigung
(ssg-json-parse
(strcat "{\"name\": \"A\", \"oben\": [{\"artikel\": \"K\", \"anzahl\": 2}],"
" \"unten\": [{\"artikel\": \"K\", \"anzahl\": 3}]}"))
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
(tu-eq "geruest-konfig-befestigung/neu" '(4)
(geruest-konfig-befestigung
(ssg-json-parse
"{\"name\": \"N\", \"befestigung\": [{\"artikel\": \"K\", \"anzahl\": 4}]}")
(geruest-anbau-liste _bgtest "befestigung")
(geruest-anbau-liste _bgtest "sonstiges")))
;; Artikelnummer(n) fuer die Anzeige: Einzelteil bzw. Gruppe eindeutig
(tu-eq "geruest-artnr-anzeige/einzelteil" "825002019"
(geruest-artnr-anzeige _eintrag))
(tu-eq "geruest-artnr-anzeige/gruppe" "111, 222"
(geruest-artnr-anzeige _gruppe))
;; Eine Befestigungsspalte (Prefix b) mit Art.-Nr.-Zeile je Teil
(setq _rec (geruest-dcl-ersetzungen "Saeulen" (list _eintrag) nil
(list '(("name" . "A")))))
(tu-true "geruest-dcl-ersetzungen/befestigung-key"
(vl-some '(lambda (z) (vl-string-search "key = \"bm0\"" z))
(cdr (assoc "BEFESTIGUNG" _rec))))
(tu-true "geruest-dcl-ersetzungen/artnr-zeile"
(vl-some '(lambda (z) (vl-string-search "Art.-Nr. 825002019" z))
(cdr (assoc "BEFESTIGUNG" _rec))))
;; --- Variante gewinnt vor Baugruppe (TEILEART/dummy) ---
;; Die zusammengefuehrte Saeulen-Baugruppe unterscheidet 1 Zoll und
;; 2 Zoll nur noch ueber das teileart-Feld der Variante.
(setq _bgtest (ssg-json-parse
"{\"teileart\": \"Basis\", \"dummy\": \"basis.dwg\"}"))
(tu-eq "geruest-variante-wert/variante-gewinnt" "Speziell"
(geruest-variante-wert
(ssg-json-parse "{\"teileart\": \"Speziell\"}") _bgtest "teileart"))
(tu-eq "geruest-variante-wert/rueckfall" "Basis"
(geruest-variante-wert
(ssg-json-parse "{\"name\": \"X\"}") _bgtest "teileart"))
(tu-eq "geruest-variante-wert/ohne-variante" "basis.dwg"
(geruest-variante-wert nil _bgtest "dummy"))
;; --- Zusammengefuehrte Saeulen-Baugruppe ---
(setq _saeulen (geruest-baugruppe "Saeulen" (geruest-daten)))
(tu-eq "geruest/saeulen-vorhanden" T (if _saeulen T nil))
(if _saeulen
(progn
;; Aufbau statt fester Anzahl - geruest.json wird noch gepflegt.
;; Jeder Artikel braucht sivas_id und ein (auch false) farbig-Feld.
(tu-eq "geruest/saeulen-varianten" T
(if (ssg-json-get _saeulen "geometrie_varianten") T nil))
(tu-eq "geruest/saeulen-varianten-artikel" 0
(tu-geruest-artikel-unvollstaendig
(ssg-json-get _saeulen "geometrie_varianten")))
(tu-eq "geruest/saeulen-anbauteile" T
(if (geruest-anbau-liste _saeulen "befestigung") T nil))
(tu-eq "geruest/saeulen-anbauteile-artikel" 0
(tu-geruest-artikel-unvollstaendig
(geruest-anbau-liste _saeulen "befestigung")))
;; Haltearme passen weder oben noch unten -> eigene Sonstiges-Zeile
(tu-eq "geruest/saeulen-sonstiges" 4
(length (geruest-anbau-liste _saeulen "sonstiges")))
(tu-eq "geruest/saeulen-sonstiges-artikel" 0
(tu-geruest-artikel-unvollstaendig
(geruest-anbau-liste _saeulen "sonstiges")))
(tu-nil "geruest/saeulen-haltearm-nicht-befestigung"
(vl-some '(lambda (a)
(wcmatch (geruest-eintrag-name a) "HALTEARM*"))
(geruest-anbau-liste _saeulen "befestigung")))
;; Rohrabhaenger/Wandbefestigung haben keine Sonstiges-Teile
(foreach _e '("Rohrabhaenger" "Wandbefestigung")
(setq _rec (geruest-baugruppe _e (geruest-daten)))
(tu-true (strcat "geruest/" _e "-befestigung")
(geruest-anbau-liste _rec "befestigung"))
(tu-nil (strcat "geruest/" _e "-ohne-sonstiges")
(geruest-anbau-liste _rec "sonstiges")))
(tu-eq "geruest/saeulen-titel" "Saeulen" (geruest-titel _saeulen))
;; Variante R 1" traegt die eigene TEILEART - per Name gesucht,
;; die Reihenfolge in geruest.json ist nicht fest.
(setq _rec (geruest-name-index "R 1\""
(ssg-json-get _saeulen "geometrie_varianten")))
(tu-eq "geruest/saeulen-1zoll-vorhanden" T (if _rec T nil))
(if _rec
(tu-eq "geruest/saeulen-1zoll-teileart" "Geruest Saeule 1 Zoll"
(geruest-variante-wert
(nth _rec (ssg-json-get _saeulen "geometrie_varianten"))
_saeulen "teileart")))
;; Attribut-Keys GROSS - sonst findet geruest-dialog min/max und
;; Farben nicht (Laengenfeld ohne Pruefung, leere Farbliste).
(tu-eq "geruest/saeulen-laenge-max" 6000
(geruest-attr-feld nil _saeulen "LAENGE" "max"))
(tu-true "geruest/saeulen-farboptionen"
(geruest-attr-feld nil _saeulen "TEILEFARBE" "optionen"))
)
)
;; --- Rohr-Geruest-Traeger: reine Berechnung ---
;; Netto-Laenge = Strecke minus beide Abzuege, nil wenn nichts uebrig
(tu-eqf "geruest-traeger-laenge/ende" 965.0 (geruest-traeger-laenge 1000.0 0.0 35.0))
(tu-eqf "geruest-traeger-laenge/beide" 945.0 (geruest-traeger-laenge 1000.0 20.0 35.0))
(tu-eqf "geruest-traeger-laenge/ohne" 1000.0 (geruest-traeger-laenge 1000.0 nil nil))
(tu-nil "geruest-traeger-laenge/zu-kurz" (geruest-traeger-laenge 50.0 30.0 30.0))
(tu-nil "geruest-traeger-laenge/genau-null" (geruest-traeger-laenge 60.0 30.0 30.0))
;; Startpunkt wird um den Anfangsabzug entlang der Richtung eingerueckt,
;; Z bleibt die des Startklicks
(tu-eqf "geruest-traeger-start/0grad" '(20.0 0.0 500.0)
(geruest-traeger-start '(0.0 0.0 500.0) 0.0 20.0))
(tu-eqf "geruest-traeger-start/90grad" '(100.0 220.0 0.0)
(geruest-traeger-start '(100.0 200.0 0.0) (/ pi 2.0) 20.0))
(tu-eqf "geruest-traeger-start/2d-punkt" '(5.0 0.0 0.0)
(geruest-traeger-start '(5.0 0.0) 0.0 0.0))
;; Querstreben: Abstand IMMER genau 500, beide Raender gleich; gewaehlt
;; wird die Strebenzahl mit dem Rand am naechsten an 100..250
;; (Gleichstand -> weniger Streben). Plan = (rand positionen).
;; Im Bereich:
(tu-eqf "geruest-traeger-plan/1000" '(250.0 (250.0 750.0))
(geruest-traeger-streben-plan 1000.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/1200" '(100.0 (100.0 600.0 1100.0))
(geruest-traeger-streben-plan 1200.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/1300" '(150.0 (150.0 650.0 1150.0))
(geruest-traeger-streben-plan 1300.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/1500" '(250.0 (250.0 750.0 1250.0))
(geruest-traeger-streben-plan 1500.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/400" '(200.0 (200.0))
(geruest-traeger-streben-plan 400.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/500" '(250.0 (250.0))
(geruest-traeger-streben-plan 500.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/200" '(100.0 (100.0))
(geruest-traeger-streben-plan 200.0 500.0 100.0 250.0))
;; Ausserhalb (netto mod 500 in (0, 200) oder netto < 200) - der Plan
;; kommt trotzdem, der Abstand bleibt 500:
;; 1100: Rand 300 (k=1) oder 50 (k=2), beide 50 daneben -> weniger Streben
(tu-eqf "geruest-traeger-plan/1100" '(300.0 (300.0 800.0))
(geruest-traeger-streben-plan 1100.0 500.0 100.0 250.0))
;; 1050: Rand 275 (25 daneben) schlaegt 25 (75 daneben)
(tu-eqf "geruest-traeger-plan/1050" '(275.0 (275.0 775.0))
(geruest-traeger-streben-plan 1050.0 500.0 100.0 250.0))
;; 1150: Rand 75 (25 daneben) schlaegt 325 (75 daneben)
(tu-eqf "geruest-traeger-plan/1150" '(75.0 (75.0 575.0 1075.0))
(geruest-traeger-streben-plan 1150.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/501" '(250.5 (250.5))
(geruest-traeger-streben-plan 501.0 500.0 100.0 250.0))
(tu-eqf "geruest-traeger-plan/kurz-150" '(75.0 (75.0))
(geruest-traeger-streben-plan 150.0 500.0 100.0 250.0))
(tu-nil "geruest-traeger-plan/null"
(geruest-traeger-streben-plan 0.0 500.0 100.0 250.0))
;; Abstand zwischen zwei Streben ist in jedem Fall exakt 500
(foreach _l '(700.0 1100.0 1150.0 2345.0 5999.0)
(setq _rec (geruest-traeger-streben _l 500.0 100.0 250.0))
(tu-true (strcat "geruest-traeger-streben/abstand-" (rtos _l 2 0))
(vl-every '(lambda (a b) (equal (- b a) 500.0 1e-6))
_rec (cdr _rec))))
;; Rand-Abweichung
(tu-eqf "geruest-rand-abweichung/innen" 0.0 (geruest-rand-abweichung 150.0 100.0 250.0))
(tu-eqf "geruest-rand-abweichung/unten" 25.0 (geruest-rand-abweichung 75.0 100.0 250.0))
(tu-eqf "geruest-rand-abweichung/oben" 50.0 (geruest-rand-abweichung 300.0 100.0 250.0))
;; 6000 mm: 11 Felder a 500 -> 12 Streben, letzte bei 5750
(setq _rec (geruest-traeger-streben 6000.0 500.0 100.0 250.0))
(tu-eq "geruest-traeger-streben/6000-anzahl" 12 (length _rec))
(tu-eqf "geruest-traeger-streben/6000-letzte" 5750.0 (last _rec))
;; Konfiguration: fehlende Felder -> Standard, ohne querstrebe -> nil
;; Ergebnis (dummy laenge querlinie abstand rand-min rand-max)
;; Streben nur bei Varianten mit "mit_querstrebe": true
(setq _vmq (ssg-json-parse "{\"name\": \"A\", \"mit_querstrebe\": true}"))
(tu-eqf "geruest-traeger-strebe-cfg/standard" '(nil 30.0 25.0 500.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq
(ssg-json-parse "{\"querstrebe\": {\"rand_min\": 100}}")))
(tu-eqf "geruest-traeger-strebe-cfg/dummy" '("s.dwg" 30.0 25.0 500.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq
(ssg-json-parse "{\"querstrebe\": {\"dummy\": \"s.dwg\"}}")))
(tu-eqf "geruest-traeger-strebe-cfg/wert" '(nil 30.0 25.0 400.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
(tu-eqf "geruest-traeger-strebe-cfg/variante" '(nil 30.0 25.0 300.0 100.0 250.0)
(geruest-traeger-strebe-cfg
(ssg-json-parse
"{\"mit_querstrebe\": true, \"querstrebe\": {\"abstand\": 300}}")
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
(tu-nil "geruest-traeger-strebe-cfg/ohne-flag"
(geruest-traeger-strebe-cfg (ssg-json-parse "{\"name\": \"Rohr 1\"}")
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
(tu-nil "geruest-traeger-strebe-cfg/ohne-variante"
(geruest-traeger-strebe-cfg nil
(ssg-json-parse "{\"querstrebe\": {\"abstand\": 400}}")))
;; Querlinien an Anfang und Ende der 30 mm langen Strebe
(tu-eqf "geruest-traeger-strebe-enden" '(235.0 265.0)
(geruest-traeger-strebe-enden 250.0 30.0))
(tu-nil "geruest-traeger-strebe-cfg/ohne"
(geruest-traeger-strebe-cfg _vmq (ssg-json-parse "{\"id\": \"X\"}")))
;; Muffe nur bei "mit_muffe": true; Variante darf eigene Muffe mitbringen
(setq _bgtest (ssg-json-parse "{\"muffe\": {\"dummy\": \"m.dwg\"}}"))
(tu-eq "geruest-traeger-muffe-dummy/flag" "m.dwg"
(geruest-traeger-muffe-dummy
(ssg-json-parse "{\"name\": \"A\", \"mit_muffe\": true}") _bgtest))
(tu-nil "geruest-traeger-muffe-dummy/ohne-flag"
(geruest-traeger-muffe-dummy
(ssg-json-parse "{\"name\": \"Rohr mit Muffe\"}") _bgtest))
(tu-eq "geruest-traeger-muffe-dummy/variante" "m2.dwg"
(geruest-traeger-muffe-dummy
(ssg-json-parse
"{\"mit_muffe\": true, \"muffe\": {\"dummy\": \"m2.dwg\"}}")
_bgtest))
(tu-nil "geruest-traeger-muffe-dummy/ohne-variante"
(geruest-traeger-muffe-dummy nil _bgtest))
;; --- Traeger-Beschriftung: reine Berechnung ---
;; Textwinkel entlang des Traegers, DIN: 90 < w <= 270 wird gedreht
(tu-eqf "geruest-text-winkel/0" 0.0 (geruest-text-winkel 0.0))
(tu-eqf "geruest-text-winkel/45" (/ pi 4.0) (geruest-text-winkel (/ pi 4.0)))
(tu-eqf "geruest-text-winkel/90" (/ pi 2.0) (geruest-text-winkel (/ pi 2.0)))
(tu-eqf "geruest-text-winkel/91" (* 271 (/ pi 180.0))
(geruest-text-winkel (* 91 (/ pi 180.0))))
(tu-eqf "geruest-text-winkel/180" 0.0 (geruest-text-winkel pi))
(tu-eqf "geruest-text-winkel/270" (/ pi 2.0) (geruest-text-winkel (* 1.5 pi)))
(tu-eqf "geruest-text-winkel/271" (* 271 (/ pi 180.0))
(geruest-text-winkel (* 271 (/ pi 180.0))))
;; -90 = 270 -> gedreht auf 90 (von unten nach oben lesbar)
(tu-eqf "geruest-text-winkel/-90" (/ pi 2.0) (geruest-text-winkel (- (/ pi 2.0))))
;; Ausrichtungs-Codes wie TEXT "Ausrichten" -> (dxf72 dxf73)
(tu-eq "geruest-ausrichtung/TL" '(0 3) (geruest-ausrichtung-codes "TL"))
(tu-eq "geruest-ausrichtung/TC" '(1 3) (geruest-ausrichtung-codes "TC"))
(tu-eq "geruest-ausrichtung/TR" '(2 3) (geruest-ausrichtung-codes "TR"))
(tu-eq "geruest-ausrichtung/ML" '(0 2) (geruest-ausrichtung-codes "ML"))
(tu-eq "geruest-ausrichtung/MC" '(1 2) (geruest-ausrichtung-codes "MC"))
(tu-eq "geruest-ausrichtung/MR" '(2 2) (geruest-ausrichtung-codes "MR"))
(tu-eq "geruest-ausrichtung/BL" '(0 1) (geruest-ausrichtung-codes "BL"))
(tu-eq "geruest-ausrichtung/BC" '(1 1) (geruest-ausrichtung-codes "BC"))
(tu-eq "geruest-ausrichtung/BR" '(2 1) (geruest-ausrichtung-codes "BR"))
(tu-eq "geruest-ausrichtung/klein" '(1 1) (geruest-ausrichtung-codes "bc"))
(tu-nil "geruest-ausrichtung/unbekannt" (geruest-ausrichtung-codes "XY"))
(tu-nil "geruest-ausrichtung/nil" (geruest-ausrichtung-codes nil))
;; Textlage: Bezugspunkt auf der Linie, "links" in Leserichtung
(tu-eqf "geruest-text-lage/0-BC" '((1000.0 0.0 0.0) 0.0 1 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "BC"))
(tu-eqf "geruest-text-lage/0-BL" '((0.0 0.0 0.0) 0.0 0 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "BL"))
(tu-eqf "geruest-text-lage/0-BR" '((2000.0 0.0 0.0) 0.0 2 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "BR"))
;; Traeger nach links (180): Text gedreht auf 0, links = Linienende
(tu-eqf "geruest-text-lage/180-BL" '((-2000.0 0.0 0.0) 0.0 0 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) pi 2000.0 "BL"))
(tu-eqf "geruest-text-lage/180-BR" '((0.0 0.0 0.0) 0.0 2 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) pi 2000.0 "BR"))
(tu-eqf "geruest-text-lage/180-BC" '((-1000.0 0.0 0.0) 0.0 1 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) pi 2000.0 "BC"))
;; Unbekannter Code -> BC
(tu-eqf "geruest-text-lage/ersatz" '((1000.0 0.0 0.0) 0.0 1 1)
(geruest-traeger-text-lage '(0.0 0.0 0.0) 0.0 2000.0 "XY"))
;; Text: %1 = Variantentext, %2 = Laenge auf ganze mm
(tu-eq "geruest-text-string/beispiel" "RT 80/80 L=2650"
(geruest-traeger-text-string "%1 L=%2" "RT 80/80" 2649.5))
(tu-eq "geruest-text-string/abrunden" "L=965 RT"
(geruest-traeger-text-string "L=%2 %1" "RT" 965.4))
(tu-eq "geruest-text-string/mehrfach" "A A 10"
(geruest-traeger-text-string "%1 %1 %2" "A" 10.0))
;; Konfiguration je Feld: Variante vor Baugruppe vor Code-Standard
(setq _bgtest (ssg-json-parse
(strcat "{\"beschriftung\": {\"format\": \"%1 L=%2\", \"stil\": \"S1\","
" \"ausrichtung\": \"BC\", \"hoehe\": 50, \"layer\": \"D-5-BEM\"}}")))
(setq _rec (geruest-traeger-beschr-cfg
(ssg-json-parse
"{\"name\": \"RT 80/80 1 Zoll\", \"beschriftung\": {\"text\": \"RT 80/80\", \"layer\": \"D-6-BEM\"}}")
_bgtest "ERSATZ"))
(tu-eq "geruest-beschr-cfg/text" "RT 80/80" (cdr (assoc "text" _rec)))
(tu-eq "geruest-beschr-cfg/layer" "D-6-BEM" (cdr (assoc "layer" _rec)))
(tu-eq "geruest-beschr-cfg/stil" "S1" (cdr (assoc "stil" _rec)))
(tu-eqf "geruest-beschr-cfg/hoehe" 50.0 (cdr (assoc "hoehe" _rec)))
(setq _rec (geruest-traeger-beschr-cfg
(ssg-json-parse "{\"name\": \"Ohne Text\"}") _bgtest "ERSATZ"))
(tu-eq "geruest-beschr-cfg/text-name" "Ohne Text" (cdr (assoc "text" _rec)))
(tu-eq "geruest-beschr-cfg/layer-bg" "D-5-BEM" (cdr (assoc "layer" _rec)))
(setq _rec (geruest-traeger-beschr-cfg nil (ssg-json-parse "{\"id\": \"X\"}") "ERSATZ"))
(tu-eq "geruest-beschr-cfg/ersatz" "ERSATZ" (cdr (assoc "text" _rec)))
(tu-eq "geruest-beschr-cfg/std-format" "%1 L=%2" (cdr (assoc "format" _rec)))
(tu-eq "geruest-beschr-cfg/std-ausr" "BC" (cdr (assoc "ausrichtung" _rec)))
(tu-eqf "geruest-beschr-cfg/std-hoehe" 50.0 (cdr (assoc "hoehe" _rec)))
(tu-nil "geruest-beschr-cfg/std-layer" (cdr (assoc "layer" _rec)))
;; Bereichspruefung auf der Netto-Laenge
(tu-true "geruest-traeger-pruefen/innen" (geruest-traeger-pruefen 965.0 0 6000))
(tu-nil "geruest-traeger-pruefen/ueber" (geruest-traeger-pruefen 6001.0 0 6000))
(tu-true "geruest-traeger-pruefen/grenze" (geruest-traeger-pruefen 6000.0 0 6000))
(tu-true "geruest-traeger-pruefen/ohne" (geruest-traeger-pruefen 99999.0 nil nil))
(tu-nil "geruest-traeger-pruefen/nil" (geruest-traeger-pruefen nil 0 6000))
;; Eingaben in mm: Komma wie Punkt, negativ/Text ungueltig
(tu-eqf "geruest-mm-zahl/ganz" 35.0 (geruest-mm-zahl "35"))
(tu-eqf "geruest-mm-zahl/komma" 17.5 (geruest-mm-zahl "17,5"))
(tu-nil "geruest-mm-zahl/text" (geruest-mm-zahl "abc"))
(tu-nil "geruest-mm-zahl/negativ" (geruest-mm-zahl "-5"))
(tu-nil "geruest-mm-zahl/leer" (geruest-mm-zahl ""))
(tu-eqf "geruest-abzug-wert/leer" 0.0 (geruest-abzug-wert ""))
(tu-nil "geruest-abzug-wert/text" (geruest-abzug-wert "x"))
(tu-eqf "geruest-tr-abzug/inaktiv" 0.0 (geruest-tr-abzug "0" "x"))
(tu-eqf "geruest-tr-abzug/aktiv" 35.0 (geruest-tr-abzug "1" "35"))
(tu-eq "geruest-mm-string/ganz" "965" (geruest-mm-string 965.0))
(tu-eq "geruest-mm-string/dezimal" "17.5" (geruest-mm-string 17.5))
;; Variante darf Attribut-Felder ueberschreiben - auch mit false
(setq _bgtest (ssg-json-parse
"{\"attribute\": {\"LAENGENABZUGENDE\": {\"vorgabe\": 35, \"aktiv\": true}}}"))
(tu-eq "geruest-attr-feld/baugruppe" 35
(geruest-attr-feld nil _bgtest "LAENGENABZUGENDE" "vorgabe"))
(tu-eq "geruest-attr-feld/variante" 50
(geruest-attr-feld
(ssg-json-parse "{\"attribute\": {\"LAENGENABZUGENDE\": {\"vorgabe\": 50}}}")
_bgtest "LAENGENABZUGENDE" "vorgabe"))
(tu-nil "geruest-attr-feld/variante-false"
(geruest-attr-feld
(ssg-json-parse "{\"attribute\": {\"LAENGENABZUGENDE\": {\"aktiv\": false}}}")
_bgtest "LAENGENABZUGENDE" "aktiv"))
;; --- Rohr-Geruest-Traeger in der echten Datendatei ---
;; Eigene Datei data/json/geruest_traeger.json: in geruest.json darf er
;; nicht stehen, ueber geruest-traeger-daten muss er auffindbar sein.
(tu-true "geruest/traeger-datei"
(findfile (geruest-json-pfad "geruest_traeger.json")))
(setq _traeger (geruest-baugruppe "Traeger" (geruest-traeger-daten)))
(tu-true "geruest/traeger-vorhanden" _traeger)
(tu-nil "geruest/traeger-nicht-in-geruest-json"
(geruest-baugruppe "Traeger" (geruest-daten)))
(if _traeger
(progn
(tu-eq "geruest/traeger-varianten-artikel" 0
(tu-geruest-artikel-unvollstaendig
(ssg-json-get _traeger "geometrie_varianten")))
(tu-true "geruest/traeger-layer"
(geruest-variante-wert
(car (ssg-json-get _traeger "geometrie_varianten"))
_traeger "layer"))
(tu-eq "geruest/traeger-max" 6000
(geruest-attr-feld nil _traeger "LAENGE" "max"))
(tu-eqf "geruest/traeger-querstrebe"
'("dummy_Strebe_30x4.dwg" 30.0 25.0 500.0 100.0 250.0)
(geruest-traeger-strebe-cfg _vmq _traeger))
;; Querstreben-Flag je Variante: alle ausser den beiden Rohr-1"-Varianten
(setq _rec 0)
(foreach _v (ssg-json-get _traeger "geometrie_varianten")
(if (geruest-traeger-strebe-cfg _v _traeger) (setq _rec (1+ _rec))))
(tu-eq "geruest/traeger-querstreben-varianten" 6 _rec)
(tu-nil "geruest/traeger-rohr-ohne-querstrebe"
(geruest-traeger-strebe-cfg
(car (ssg-json-get _traeger "geometrie_varianten")) _traeger))
;; Muffen-Flag ausdruecklich je Variante: genau die "mit (2) Muffe(n)"
(setq _rec 0)
(foreach _v (ssg-json-get _traeger "geometrie_varianten")
(if (geruest-traeger-muffe-dummy _v _traeger) (setq _rec (1+ _rec))))
(tu-eq "geruest/traeger-muffen-varianten" 4 _rec)
;; Dialog: ein Radiobutton je Variante, auch fuer die mit Muffe
(tu-eq "geruest/traeger-radiobuttons" 8
(length (geruest-dcl-varianten-zeilen
(ssg-json-get _traeger "geometrie_varianten")
(geruest-indizes (length (ssg-json-get _traeger
"geometrie_varianten"))))))
;; Jede Variante definiert Beschriftungstext UND -layer selbst - der
;; Layer ist je Traegervariante verschieden, eine Vorgabe der
;; Baugruppe gibt es dafuer bewusst nicht.
(setq _rec 0)
(foreach _v (ssg-json-get _traeger "geometrie_varianten")
(setq _cfg (geruest-traeger-beschr-cfg _v _traeger ""))
(if (and (geruest-obj-feld _v _traeger '("beschriftung") "text")
(/= (cdr (assoc "text" _cfg)) "")
(geruest-json-pfad-get _v '("beschriftung" "layer"))
(geruest-ausrichtung-codes (cdr (assoc "ausrichtung" _cfg))))
(setq _rec (1+ _rec))))
(tu-eq "geruest/traeger-beschriftung-varianten"
(length (ssg-json-get _traeger "geometrie_varianten")) _rec)
;; VARIANTE gehoert zum Traeger-Schema (Grundlage fuer das Neubeschriften)
(tu-true "geruest/traeger-attrib-variante"
(assoc "VARIANTE" *geruest-traeger-attrib-defs*))
;; Beide Dummy-DWGs liegen unter data/geruest
(tu-true "geruest/traeger-strebe-dwg"
(findfile (geruest-dummy-pfad "dummy_Strebe_30x4.dwg")))
(tu-true "geruest/traeger-muffe-dwg"
(findfile (geruest-dummy-pfad "dummy_Muffe_1zoll.dwg")))
)
)
;; --- Omniflo-Fahrstrecke (data/json/omniflo_fahrstrecke.json) ---
;; Gleiche Linien-Logik wie der Traeger: jede Variante ein Radiobutton,
;; nur ST/STL gibt es mit Muffen, nur ST/STL sind farbig.
(setq _fs (geruest-baugruppe "Fahrstrecke" (geruest-fahrstrecke-daten)))
(tu-true "fahrstrecke/vorhanden" _fs)
(if _fs
(progn
(setq _rec (ssg-json-get _fs "geometrie_varianten"))
(tu-eq "fahrstrecke/titel" "Fahrstrecke" (geruest-titel _fs))
(tu-eq "fahrstrecke/varianten"
'("AP 110" "APG 110" "AP 60" "ST" "ST mit Muffen" "STL" "STL mit Muffen")
(mapcar 'geruest-eintrag-name _rec))
(tu-eq "fahrstrecke/mit-muffe" '("ST mit Muffen" "STL mit Muffen")
(mapcar 'geruest-eintrag-name
(vl-remove-if-not '(lambda (v) (ssg-json-get v "mit_muffe")) _rec)))
;; AP 110 ohne "farbig" -> leerer TEILEFARBE-Eintrag, ST farbig
(tu-eq "fahrstrecke/ap110-nicht-farbig" '("")
(geruest-farbliste (geruest-teile-paare (nth 0 _rec) nil) "RAL7035"))
(tu-eq "fahrstrecke/st-farbig" '("RAL7035")
(geruest-farbliste
(geruest-teile-paare
(nth (geruest-name-index "ST" _rec) _rec) nil)
"RAL7035"))
;; Keine Querstreben; Muffen-Dummy wie beim Traeger nur bei den
;; Varianten mit "mit_muffe": true
(tu-nil "fahrstrecke/ohne-querstrebe"
(geruest-traeger-strebe-cfg (nth (geruest-name-index "ST" _rec) _rec) _fs))
(tu-eq "fahrstrecke/muffe-dummy" "dummy_Muffe_1zoll.dwg"
(geruest-traeger-muffe-dummy
(nth (geruest-name-index "ST mit Muffen" _rec) _rec) _fs))
(tu-nil "fahrstrecke/ohne-muffe-dummy"
(geruest-traeger-muffe-dummy
(nth (geruest-name-index "ST" _rec) _rec) _fs))
)
)
(tu-true "fahrstrecke/dcl-vorlage"
(findfile (geruest-dcl-vorlage-pfad "fahrstrecke.dcl")))
;; --- Rundlauf Schreiber -> Parser ---
;; Prueft den Konfigurations-Schreiber ohne BricsCAD-Dialog. Bewusst in
;; eine temporaere Datei: ein Test darf cfg/geruest_user.json nicht
;; ueberschreiben. Die Testdaten enthalten absichtlich Anfuehrungs-
;; zeichen - genau daran wuerde eine fehlende Maskierung scheitern.
(setq _rec
(list (cons "name" "Mein \"Satz\"")
(cons "variante" "ROHR R 1\" 33,7 x 2,6")
(cons "laenge" "2000")
(cons "teilefarbe" "RAL 7035 Lichtgrau")
(cons "befestigung" (list (list (cons "artikel" "ROHRKLAMMER 1\" KPL. VERTIKAL")
(cons "anzahl" 2))))
(cons "sonstiges" nil)
(cons "winkel_platte" 90)))
(setq _pfad (vl-filename-mktemp "grtest" nil ".json"))
(setq _f (open _pfad "w"))
(write-line "{ \"Test\": [" _f)
(geruest-konfig-liste-schreiben _f (list _rec))
(write-line "] }" _f)
(close _f)
(setq _zurueck (car (ssg-json-get (ssg-json-laden _pfad) "Test")))
(vl-file-delete _pfad)
(tu-eq "geruest-schreiber/name" "Mein \"Satz\""
(ssg-json-get _zurueck "name"))
(tu-eq "geruest-schreiber/variante" "ROHR R 1\" 33,7 x 2,6"
(ssg-json-get _zurueck "variante"))
(tu-eq "geruest-schreiber/laenge" "2000"
(ssg-json-get _zurueck "laenge"))
(tu-eq "geruest-schreiber/farbe" "RAL 7035 Lichtgrau"
(ssg-json-get _zurueck "teilefarbe"))
(tu-eq "geruest-schreiber/befestigung-artikel" "ROHRKLAMMER 1\" KPL. VERTIKAL"
(ssg-json-get (car (ssg-json-get _zurueck "befestigung")) "artikel"))
(tu-eq "geruest-schreiber/befestigung-anzahl" 2
(ssg-json-get (car (ssg-json-get _zurueck "befestigung")) "anzahl"))
(tu-eq "geruest-schreiber/sonstiges-leer" nil
(ssg-json-get _zurueck "sonstiges"))
(tu-eq "geruest-schreiber/winkel" 90
(ssg-json-get _zurueck "winkel_platte"))
;; altes Format wird nicht mehr geschrieben
(tu-nil "geruest-schreiber/ohne-oben" (assoc "oben" _zurueck))
)
)
)
;; ------------------------------------------------------------
;; TESTS: count_sep_scan.lsp - geometrische Sensor-Zuordnung
;;
;; Testet die durch die Zerlegung von cs-zuordnung-lauf isolierte,
;; rein funktionale Kernlogik: Carrier-Records sind plain Listen
;; (ename tagS tagP minx miny maxx maxy cx cy id label), Sensoren
;; sind Punkte (x y). Kein ssget/entget/entmod - der ename an
;; Position 0 wird von den Geometrie-Routinen nie dereferenziert,
;; darum genuegt ein Symbol-Platzhalter. *senstol* wird fuer
;; deterministische Ergebnisse explizit gesetzt (sonst cfg-abhaengig).
;; ------------------------------------------------------------
;; Record-Konstruktor fuers Testen: baut einen Carrier-Record so, wie
;; ihn cs-sammle-bloecke liefert - nur die Box-/Zentrum-/ID-Felder
;; (Index 3-9), die die Geometrie-Routinen lesen, sind relevant; ename
;; und label sind reine Platzhalter.
;; (name minx miny maxx maxy id) -> voller Carrier-Record
(defun tu-mk-carr (name minx miny maxx maxy id)
(list name "ANZAHL_SCANNER" "ANZAHL_SEPARATOR"
minx miny maxx maxy
(/ (+ minx maxx) 2.0) (/ (+ miny maxy) 2.0)
id (strcat "L-" name)))
(defun tu-tests-sepscan ( / _senstol-alt _a _b _c _carr _grid _res)
(princ "\n[count_sep_scan]")
;; count_sep_scan ist ein lazy Feature-Modul (nicht in der Core-Ladeliste).
;; Geladen wird es zentral in test_unit.scr auf .scr-Top-Level; hier nur
;; pruefen, ob es da ist (siehe Kopfkommentar zur Ladearchitektur).
(if (null (atoms-family 1 '("CS-RESOLVE-SENSOR")))
(tu-record nil "sepscan/modul" "count_sep_scan.lsp nicht geladen")
(progn
(setq _senstol-alt (if (boundp '*senstol*) *senstol*))
(setq *senstol* 0.0)
;; --- cs-in-box: Punkt in Carrier-Box (X/Y, Z ignoriert) ---
(setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001"))
(tu-true "cs-in-box/mitte" (cs-in-box '(50.0 50.0) _a))
(tu-true "cs-in-box/rand" (cs-in-box '(0.0 0.0) _a))
(tu-nil "cs-in-box/ausserhalb-x" (cs-in-box '(150.0 50.0) _a))
(tu-nil "cs-in-box/ausserhalb-y" (cs-in-box '(50.0 -1.0) _a))
;; --- *senstol* vergroessert die Box ---
(setq *senstol* 10.0)
(tu-true "cs-in-box/toleranz-innen" (cs-in-box '(105.0 50.0) _a))
(tu-nil "cs-in-box/toleranz-aussen" (cs-in-box '(111.0 50.0) _a))
(setq *senstol* 0.0)
;; --- cs-bump: Zaehler je ename hochzaehlen ---
(tu-eq "cs-bump/neu" '(("k" . 1)) (cs-bump nil "k"))
(tu-eq "cs-bump/erhoeht" '(("k" . 2)) (cs-bump '(("k" . 1)) "k"))
(tu-eq "cs-bump/zweiter-key"
'(("m" . 1) ("k" . 1)) (cs-bump '(("k" . 1)) "m"))
;; --- cs-carrier-by-id: Record ueber ID (Feld 9) finden ---
(setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002"))
(setq _carr (list _a _b))
(tu-eq "cs-carrier-by-id/treffer" _b (cs-carrier-by-id "0002" _carr))
(tu-nil "cs-carrier-by-id/fehlt" (cs-carrier-by-id "9999" _carr))
(tu-nil "cs-carrier-by-id/leer" (cs-carrier-by-id "" _carr))
(tu-nil "cs-carrier-by-id/nil" (cs-carrier-by-id nil _carr))
;; --- cs-assign: BBox-Zuordnung ueber das Grid ---
;; Zwei getrennte Boxen: Punkt in genau einer -> diese.
(setq _grid (cs-grid-build _carr))
(tu-eq "cs-assign/box-a" _a (cs-assign '(50.0 50.0) _grid))
(tu-eq "cs-assign/box-b" _b (cs-assign '(250.0 50.0) _grid))
(tu-nil "cs-assign/keine-box" (cs-assign '(1000.0 1000.0) _grid))
;; Ueberlappende Boxen -> naechstes Box-Zentrum gewinnt (Tiebreak).
;; C: 0..100, D: 40..200; Punkt (45,50) liegt in beiden,
;; C-Zentrum (50,50) ist naeher als D-Zentrum (120,50).
(setq _a (tu-mk-carr "C" 0.0 0.0 100.0 100.0 "0003"))
(setq _b (tu-mk-carr "D" 40.0 0.0 200.0 100.0 "0004"))
(setq _grid (cs-grid-build (list _a _b)))
(tu-eq "cs-assign/overlap-naechstes-zentrum"
_a (cs-assign '(45.0 50.0) _grid))
;; --- cs-nearest-two: die zwei naechsten Carrier nach Zentrum ---
;; Zentren: A(50,50) B(250,50) C(50,250). Punkt (60,60):
;; naechster A, zweiter B (dx 190 < dy 190? -> Abstand B=~194, C=~190).
(setq _a (tu-mk-carr "A" 0.0 0.0 100.0 100.0 "0001"))
(setq _b (tu-mk-carr "B" 200.0 0.0 300.0 100.0 "0002"))
(setq _c (tu-mk-carr "C" 0.0 200.0 100.0 300.0 "0003"))
(setq _res (cs-nearest-two '(60.0 60.0) (list _a _b _c)))
(tu-eq "cs-nearest-two/naechster" _a (nth 0 _res))
(tu-true "cs-nearest-two/zweiter-vorhanden" (nth 2 _res))
;; Abstand zum naechsten (A-Zentrum 50,50) = sqrt(10^2+10^2) ~ 14.14
(tu-eqf "cs-nearest-two/best-dist"
(distance '(60.0 60.0) '(50.0 50.0)) (nth 1 _res))
;; Nur ein Carrier -> zweiter ist nil.
(setq _res (cs-nearest-two '(60.0 60.0) (list _a)))
(tu-eq "cs-nearest-two/einzeln-best" _a (nth 0 _res))
(tu-nil "cs-nearest-two/einzeln-kein-zweiter" (nth 2 _res))
;; --- cs-resolve-sensor: der Entscheider bbox/distance/none ---
;; Punkt in einer Box -> modus 'bbox, kein Distanzfeld.
(setq _grid (cs-grid-build (list _a _b _c)))
(setq _res (cs-resolve-sensor '(50.0 50.0) (list _a _b _c) _grid))
(tu-eq "cs-resolve/bbox-modus" 'bbox (nth 0 _res))
(tu-eq "cs-resolve/bbox-rec" _a (nth 1 _res))
(tu-nil "cs-resolve/bbox-kein-dist" (nth 2 _res))
;; Punkt ausserhalb aller Boxen, aber Carrier vorhanden -> 'distance.
(setq _res (cs-resolve-sensor '(1000.0 1000.0) (list _a _b _c) _grid))
(tu-eq "cs-resolve/distance-modus" 'distance (nth 0 _res))
(tu-true "cs-resolve/distance-rec" (nth 1 _res))
(tu-true "cs-resolve/distance-dist" (nth 2 _res))
;; Gar keine Carrier -> 'none.
(setq _grid (cs-grid-build nil))
(setq _res (cs-resolve-sensor '(50.0 50.0) nil _grid))
(tu-eq "cs-resolve/none-modus" 'none (nth 0 _res))
(tu-nil "cs-resolve/none-rec" (nth 1 _res))
;; *senstol* wieder herstellen
(setq *senstol* _senstol-alt)
)
)
)
;; ------------------------------------------------------------
;; REPORT SCHREIBEN
;; ------------------------------------------------------------
(defun tu-write-report (pfad / f res)
(setq f (open pfad "w"))
(if f
(progn
(write-line "# SSG_LIB LISP Unit-Test Report" f)
(foreach res (reverse *tu-results*)
(write-line
(strcat (if (car res) "PASS: " "FAIL: ") (cadr res)
(if (car res) "" (strcat " | " (caddr res))))
f))
(write-line (strcat "SUMMARY: total=" (itoa (+ *tu-pass* *tu-fail*))
" passed=" (itoa *tu-pass*)
" failed=" (itoa *tu-fail*)) f)
(write-line (if (= *tu-fail* 0) "RESULT: OK" "RESULT: FAIL") f)
(close f)
T
)
nil
)
)
;; ------------------------------------------------------------
;; TESTS: vf_linienzug.lsp - SEGS-Journal-Serialisierung (Modus 3)
;; ------------------------------------------------------------
;; Roundtrip der Segment-Essenz: die Zahlenliste, die Modus 3 aus den Pfad-
;; Objekten ableitet, muss verlustfrei durch String<->Liste und durch die
;; Journal-Eintrags-Serialisierung laufen - das ist die Grundlage dafuer, dass
;; ein Modus-3-Block per Doppelklick 1:1 aus dem XDATA-Journal nachgebaut wird.
(defun tu-tests-vfl-segs ( / _seg _segs _s _e)
(princ "\n[vf_linienzug/SEGS]")
(if (null (atoms-family 1 '("VFL-SEGS->STRING")))
(tu-record nil "vfl-segs/modul" "vf_linienzug.lsp nicht geladen (VFL-SEGS->STRING fehlt)")
(progn
;; Einzelsegment (Bogen, alle Felder gesetzt) Roundtrip
(setq _seg '("Bogen" 102.5 707.106781 90 "rechts" 1000.0 2000.0 1500.5 2500.25))
(tu-eqf "vfl-seg/roundtrip-bogen"
_seg (vfl-string->seg (vfl-seg->string _seg)))
;; Linie (bwinkel 0, bseite default) Roundtrip
(setq _seg '("Linie" 30.0 4200.0 0 "links" 0.0 0.0 3637.31 2100.0))
(tu-eqf "vfl-seg/roundtrip-linie"
_seg (vfl-string->seg (vfl-seg->string _seg)))
;; Ganze Segmentliste (Linie + Bogen + Linie) Roundtrip
(setq _segs (list '("Linie" 0.0 3000.0 0 "links" 0.0 0.0 3000.0 0.0)
'("Bogen" 0.0 707.106781 90 "rechts" 3000.0 0.0 3500.0 -500.0)
'("Linie" 270.0 2500.0 0 "links" 3500.0 -500.0 3500.0 -3000.0)))
(tu-eqf "vfl-segs/roundtrip-liste"
_segs (vfl-string->segs (vfl-segs->string _segs)))
;; Leere Liste -> "" -> leere Liste
(tu-eq "vfl-segs/leer-string" "" (vfl-segs->string '()))
(tu-nil "vfl-segs/leer-parse" (vfl-string->segs ""))
;; Einbettung als Journal-Eintrag: (SEGS . liste) durch
;; vfl-entry->string / vfl-string->entry
(setq _e (cons "SEGS" _segs))
(setq _s (vfl-entry->string _e))
(tu-true "vfl-segs/entry-praefix" (= "SEGS:" (substr _s 1 5)))
(tu-eqf "vfl-segs/entry-roundtrip"
_e (vfl-string->entry _s))
;; Delimiter-Sicherheit: die serialisierte Form enthaelt genau die
;; erwarteten Trenner und KEIN Newline (sonst zerrisse der Record-Trenner)
(tu-nil "vfl-segs/kein-newline"
(vl-string-search "\n" (vfl-segs->string _segs)))
;; vfl-journal-hat-segs-p: unterscheidet neue SEGS-Ketten von alten
;; OBJS-"linienzug2"-Bloecken (harter Schnitt beim Doppelklick).
(if (atoms-family 1 '("VFL-JOURNAL-HAT-SEGS-P"))
(progn
;; SEGS-Journal (Modus 2 neu / Modus 3): erkannt
(tu-true "vfl-hat-segs/mit-segs"
(vfl-journal-hat-segs-p
(list (cons "PT" '(0.0 0.0 0.0)) (cons "SEGS" _segs))))
;; Altes OBJS-Journal (Objekt-Handles): NICHT als SEGS erkannt
(tu-nil "vfl-hat-segs/nur-objs"
(vfl-journal-hat-segs-p
(list (cons "PT" '(0.0 0.0 0.0)) (cons "OBJS" '("A1" "A2")))))
;; Leeres Journal: nil
(tu-nil "vfl-hat-segs/leer" (vfl-journal-hat-segs-p '())))
(tu-record nil "vfl-hat-segs/modul" "VFL-JOURNAL-HAT-SEGS-P fehlt"))
)
)
)
;; ------------------------------------------------------------
;; TESTS: vf_linienzug.lsp - gemeinsamer Abbruch-Handler-Konstruktor
;; ------------------------------------------------------------
;; vfl-abbruch-handler-installieren baut *error* als Lambda-Liste, in die der
;; Marker ("linienzug"/"linienzug2"/"linienzug3") als String-Literal eingebaut
;; ist. Der wortgleiche Wickel-Handler steht damit nur noch EINMAL statt 3x.
;; Getestet wird die KONSTRUKTION (Marker an der richtigen Stelle, Struktur
;; aufrufbar) - NICHT ein echter Abbruch (der braeuchte Zeichnung/Geometrie).
;; *error* wird gesichert und wiederhergestellt, damit der Testlauf unberuehrt
;; bleibt.
(defun tu-tests-vfl-abbruch ( / _save _h _call)
(princ "\n[vf_linienzug/Abbruch-Handler]")
(if (null (atoms-family 1 '("VFL-ABBRUCH-HANDLER-INSTALLIEREN")))
(tu-record nil "vfl-abbruch/modul"
"vf_linienzug.lsp nicht geladen (VFL-ABBRUCH-HANDLER-INSTALLIEREN fehlt)")
(progn
(setq _save *error*)
(setq _h (vfl-abbruch-handler-installieren "linienzug2"))
;; Rueckgabe = das gesetzte *error* (identisch)
(tu-true "vfl-abbruch/setzt-error" (equal _h *error*))
;; Struktur: (lambda (msg) ...) - erstes Element lambda, zweites (msg)
(tu-eq "vfl-abbruch/ist-lambda" 'lambda (car _h))
(tu-eq "vfl-abbruch/arg-msg" '(msg) (cadr _h))
;; Der vfl-modus-abbruch-sichern-Aufruf im Rumpf traegt GENAU den
;; uebergebenen Marker als letztes Argument (nicht einen anderen Modus).
(setq _call (car (vl-member-if
(function (lambda (f)
(and (listp f) (eq (car f) 'vfl-modus-abbruch-sichern))))
(cddr _h))))
(tu-true "vfl-abbruch/ruft-sichern" (not (null _call)))
(tu-eq "vfl-abbruch/marker-linienzug2" "linienzug2" (last _call))
;; Anderer Marker -> anderes Literal an derselben Position
(vfl-abbruch-handler-installieren "linienzug3")
(setq _call (car (vl-member-if
(function (lambda (f)
(and (listp f) (eq (car f) 'vfl-modus-abbruch-sichern))))
(cddr *error*))))
(tu-eq "vfl-abbruch/marker-linienzug3" "linienzug3" (last _call))
;; *error* wiederherstellen - Testlauf darf nicht mit einem Wickel-Handler
;; ohne gebundene Modus-Locals zurueckbleiben.
(setq *error* _save)
)
)
)
;; ------------------------------------------------------------
;; BEFEHL: TEST_UNIT
;; ------------------------------------------------------------
;; Testblock geschuetzt aufrufen: ein harter LISP-Fehler in einem Block
;; wird als FAIL erfasst, statt c:TEST_UNIT abzubrechen und damit den
;; Report zu verhindern. Der Blockname (String) wird per read zur Funktion.
(defun tu-run-block (fn / res)
(setq res (vl-catch-all-apply (read fn) nil))
(if (vl-catch-all-error-p res)
(tu-record nil (strcat fn "/ausfuehrung")
(strcat "harter Fehler: " (vl-catch-all-error-message res))))
)
;; ------------------------------------------------------------
;; TESTS: ssg_input / ssg_blocktools / ssg_texttools - reine Funktionen
;; (die interaktiven Befehle SSG_BLOCK_*, SSG_ATTR_ERSETZEN, SSG_TEXT_*
;; brauchen eine Zeichnung und sind hier NICHT abgedeckt)
;; ------------------------------------------------------------
(defun tu-tests-werkzeuge ( / _e)
(princ "\n[ssg_input / ssg_blocktools / ssg_texttools / ssg_stueckliste]")
(if (not (and (car (atoms-family 1 '("SSG-IN-DEFAULT")))
(car (atoms-family 1 '("SSG-BT-WERT-NEU")))
(car (atoms-family 1 '("SSG-TT-LESBARER-WINKEL")))
(car (atoms-family 1 '("SSG-SL-KLASSE")))))
(tu-record nil "werkzeuge/geladen"
"ssg_input/ssg_blocktools/ssg_texttools/ssg_stueckliste nicht geladen (ssg_load.lsp)")
(progn
;; --- ssg_input ---
(tu-eqf "ssg-in-default/vorgabe" 5.0 (ssg-in-default nil 5.0))
(tu-eqf "ssg-in-default/eingabe" 3.0 (ssg-in-default 3.0 5.0))
(tu-nil "ssg-in-default/beides-nil" (ssg-in-default nil nil))
(tu-eq "ssg-in-fmt-real/ganz" "5" (ssg-in-fmt-real 5.0))
(tu-eq "ssg-in-fmt-real/halb" "2.5" (ssg-in-fmt-real 2.5))
(tu-eq "ssg-in-fmt-real/null" "0" (ssg-in-fmt-real 0.0))
(tu-eq "ssg-in-fmt-real/hundert" "100" (ssg-in-fmt-real 100.0))
(tu-eq "ssg-in-fmt-real/bruch" "0.125" (ssg-in-fmt-real 0.125))
(tu-eq "ssg-in-fmt-real/negativ" "-1.5" (ssg-in-fmt-real -1.5))
(tu-eq "ssg-in-fmt-pt/3d" "1,2.5,0" (ssg-in-fmt-pt '(1.0 2.5 0.0)))
(tu-eq "ssg-in-fmt-pt/2d" "1,2,0" (ssg-in-fmt-pt '(1.0 2.0)))
(tu-eq "ssg-in-prompt/mit-vorgabe" "\nHoehe <5>: " (ssg-in-prompt "\nHoehe" "5"))
(tu-eq "ssg-in-prompt/ohne" "\nHoehe: " (ssg-in-prompt "\nHoehe" nil))
(tu-eq "ssg-in-first-word" "Ja" (ssg-in-first-word "Ja Nein"))
(tu-eq "ssg-in-first-word/ein-wort" "Ja" (ssg-in-first-word "Ja"))
(tu-eq "ssg-in-second-word" "Nein" (ssg-in-second-word "Ja Nein"))
(tu-eq "ssg-in-second-word/ein-wort" "" (ssg-in-second-word "Ja"))
;; --- ssg_blocktools ---
(tu-true "ssg-bt-name-passt-p/muster" (ssg-bt-name-passt-p "GR_TR_1" "gr_*"))
(tu-nil "ssg-bt-name-passt-p/kein" (ssg-bt-name-passt-p "GR_TR_1" "XX*"))
(tu-true "ssg-bt-name-passt-p/nil" (ssg-bt-name-passt-p "ABC" nil))
(tu-true "ssg-bt-name-passt-p/leer" (ssg-bt-name-passt-p "ABC" ""))
(tu-true "ssg-bt-name-passt-p/escape-ja" (ssg-bt-name-passt-p "A.B" "A`.B"))
(tu-nil "ssg-bt-name-passt-p/escape-nein" (ssg-bt-name-passt-p "AxB" "A`.B"))
(tu-eq "ssg-bt-muster-escape" "A`.B`#1" (ssg-bt-muster-escape "A.B#1"))
(tu-eq "ssg-bt-muster-anzeige" "A.B#1" (ssg-bt-muster-anzeige "A`.B`#1"))
(tu-eq "ssg-bt-zaehle-namen"
'(("Alpha" . 1) ("Beta" . 1) ("Zeta" . 3))
(ssg-bt-zaehle-namen '("Zeta" "Alpha" "Zeta" "Beta" "Zeta")))
(tu-nil "ssg-bt-zaehle-namen/leer" (ssg-bt-zaehle-namen nil))
(tu-eq "ssg-bt-wert-neu/teil" "ABC_1" (ssg-bt-wert-neu "ABC-1" "-" "_" T))
(tu-eq "ssg-bt-wert-neu/mehrfach" "a.b.c" (ssg-bt-wert-neu "a-b-c" "-" "." T))
(tu-eq "ssg-bt-wert-neu/loeschen" "AC" (ssg-bt-wert-neu "ABC" "B" "" T))
(tu-nil "ssg-bt-wert-neu/kein-treffer" (ssg-bt-wert-neu "ABC" "X" "y" T))
(tu-eq "ssg-bt-wert-neu/gesamt-ja" "X" (ssg-bt-wert-neu "ABC" "ABC" "X" nil))
(tu-nil "ssg-bt-wert-neu/gesamt-nein" (ssg-bt-wert-neu "ABCD" "ABC" "X" nil))
(tu-nil "ssg-bt-wert-neu/leere-suche" (ssg-bt-wert-neu "ABC" "" "X" T))
(tu-nil "ssg-bt-wert-neu/gross-klein" (ssg-bt-wert-neu "abc" "ABC" "X" T))
;; --- ssg_texttools ---
(tu-eqf "ssg-tt-lesbarer-winkel/0" 0.0 (ssg-tt-lesbarer-winkel 0.0))
(tu-eqf "ssg-tt-lesbarer-winkel/45" (/ pi 4.0) (ssg-tt-lesbarer-winkel (/ pi 4.0)))
(tu-eqf "ssg-tt-lesbarer-winkel/90" (/ pi 2.0) (ssg-tt-lesbarer-winkel (/ pi 2.0)))
(tu-eqf "ssg-tt-lesbarer-winkel/135" (* 1.75 pi) (ssg-tt-lesbarer-winkel (* 0.75 pi)))
(tu-eqf "ssg-tt-lesbarer-winkel/180" 0.0 (ssg-tt-lesbarer-winkel pi))
(tu-eqf "ssg-tt-lesbarer-winkel/270" (/ pi 2.0) (ssg-tt-lesbarer-winkel (* 1.5 pi)))
(tu-eqf "ssg-tt-lesbarer-winkel/-45" (* 1.75 pi) (ssg-tt-lesbarer-winkel (- (/ pi 4.0))))
(tu-eqf "ssg-tt-lesbarer-winkel/360" 0.0 (ssg-tt-lesbarer-winkel (* 2.0 pi)))
(tu-eqf "ssg-tt-versetzt/x" '(5.0 0.0 0.0) (ssg-tt-versetzt '(0.0 0.0 0.0) 0.0 5.0))
(tu-eqf "ssg-tt-versetzt/y" '(0.0 2.0 0.0) (ssg-tt-versetzt '(0.0 0.0 0.0) (/ pi 2.0) 2.0))
(tu-eqf "ssg-tt-versetzt/2d" '(1.0 4.0 0.0) (ssg-tt-versetzt '(1.0 1.0) (/ pi 2.0) 3.0))
;; --- ssg_stueckliste: ssg-sl-klasse (Elementerkennung) ---
(tu-eq "ssg-sl-klasse/kreisel" "ils_kreisel" (car (ssg-sl-klasse "KREISEL_1_STANDARD_2300")))
(tu-eq "ssg-sl-klasse/eckrad" "ils_kreisel" (car (ssg-sl-klasse "ECKRAD_3")))
(tu-eq "ssg-sl-klasse/vf" "ils_strecke" (car (ssg-sl-klasse "VF_2")))
(tu-eq "ssg-sl-klasse/gf" "ils_strecke" (car (ssg-sl-klasse "GF_1")))
(tu-eq "ssg-sl-klasse/geruest" "geruest" (car (ssg-sl-klasse "GR_Saeulen_20260101120000")))
(tu-eq "ssg-sl-klasse/fahrstrecke" "fahrstrecke" (car (ssg-sl-klasse "GR_Fahrstrecke_20260101120000")))
(tu-eq "ssg-sl-klasse/ap60" "ap60" (car (ssg-sl-klasse "AP60_20260101120000")))
(tu-eq "ssg-sl-klasse/apg110" "apg110" (car (ssg-sl-klasse "APG110_20260101120000")))
(tu-eq "ssg-sl-klasse/ap110" "ap110" (car (ssg-sl-klasse "AP110_20260101120000")))
(tu-eq "ssg-sl-klasse/ap_110" "ap110" (car (ssg-sl-klasse "AP_110_20260101120000")))
(tu-eq "ssg-sl-klasse/klein" "ap60" (car (ssg-sl-klasse "ap60_test")))
(tu-nil "ssg-sl-klasse/unbekannt" (ssg-sl-klasse "SONSTIGER_BLOCK"))
;; Leerer/nil Auswahlsatz -> keine Elemente (der Treffer-Pfad braucht
;; echte Entities und ist nur im Szenario-Test abgedeckt).
(tu-nil "ssg-sl-elemente-aus-ss/nil" (ssg-sl-elemente-aus-ss nil))
;; ssg-sl-gruppieren-werte = reiner Kern ohne Zeichnungszugriff; die
;; Laengenermittlung aus der Zeichnung ist in ssg-sl-gruppieren getrennt.
(tu-eq "ssg-sl-gruppieren-werte/zaehlung-und-summe"
'(("a" "Bez-A" 2 300.0) ("b" "Bez-B" 1 50.0))
(ssg-sl-gruppieren-werte
(list (list "a" "Bez-A" 100.0)
(list "b" "Bez-B" 50.0)
(list "a" "Bez-A" 200.0))))
(tu-nil "ssg-sl-gruppieren-werte/leer" (ssg-sl-gruppieren-werte nil))
)
)
)
;; ------------------------------------------------------------
;; TESTS: KettenFoerderer.lsp + ssg_ks_insert.lsp (KS-Orientierung)
;; ------------------------------------------------------------
;; Reine Rechenkerne des Kettenfoerderers: Hoehenbilanz, Massstab,
;; Grenzpruefung, KS-Winkel. Alles ohne Zeichnung und ohne Blockdateien -
;; die zeichnungsabhaengigen Teile (kf-geometrie-messen, kf-kette-bauen)
;; brauchen BricsCAD und bleiben dem Befehl KF_KS_PRUEFEN vorbehalten.
(defun tu-tests-kf ( / _l _s _defs)
(princ "\n[KettenFoerderer]")
(if (not (car (atoms-family 1 '("KF-LAENGE-BERECHNEN"))))
(tu-record nil "KettenFoerderer-Modul geladen"
"KettenFoerderer.lsp nicht geladen - siehe tests/test_unit.scr")
(progn
;; --- ks-winkel-normalisieren: auf -180..180 falten ---
(tu-eqf "ks-winkel-norm/190" -170.0 (ks-winkel-normalisieren 190.0))
(tu-eqf "ks-winkel-norm/-190" 170.0 (ks-winkel-normalisieren -190.0))
(tu-eqf "ks-winkel-norm/26" 26.0 (ks-winkel-normalisieren 26.0))
(tu-eqf "ks-winkel-norm/360" 0.0 (ks-winkel-normalisieren 360.0))
(tu-nil "ks-winkel-norm/nil" (ks-winkel-normalisieren nil))
;; --- ks-xy-winkel: X-Achse eines KS-Eintrags (origin x-end y-end z-end)
(tu-eqf "ks-xy-winkel/entlang-X" 0.0
(ks-xy-winkel '((0.0 0.0 0.0) (1.0 0.0 0.0) (0.0 2.0 0.0) (0.0 0.0 3.0))))
(tu-eqf "ks-xy-winkel/entlang-Y" 90.0
(ks-xy-winkel '((0.0 0.0 0.0) (0.0 1.0 0.0) (-2.0 0.0 0.0) (0.0 0.0 3.0))))
;; versetzter Ursprung: nur die RICHTUNG zaehlt, nicht die Lage
(tu-eqf "ks-xy-winkel/versetzt-45" 45.0
(ks-xy-winkel (list '(100.0 50.0 0.0) '(101.0 51.0 0.0) '(99.0 51.0 0.0) '(100.0 50.0 1.0))))
;; senkrechte X-Achse (keine XY-Laenge) -> nil statt Division durch 0
(tu-nil "ks-xy-winkel/senkrecht"
(ks-xy-winkel '((0.0 0.0 0.0) (0.0 0.0 1.0) (0.0 2.0 0.0) (0.0 0.0 3.0))))
;; --- kf-hz-folge: Folgebaustein an KS_AUS des Vorgaengers ausrichten ---
;; Vorgaenger zeigt 26 Grad, Folgebaustein ist waagerecht gezeichnet (0)
(tu-eqf "kf-hz-folge/26-auf-0" 26.0 (kf-hz-folge 26.0 0.0))
;; Folgebaustein ist selbst schon um 26 Grad gezeichnet -> keine Drehung
(tu-eqf "kf-hz-folge/26-auf-26" 0.0 (kf-hz-folge 26.0 26.0))
;; fehlende Eigenrichtung -> Baustein uebernimmt die Vorgaengerrichtung
(tu-eqf "kf-hz-folge/ohne-beta" 26.0 (kf-hz-folge 26.0 nil))
(tu-nil "kf-hz-folge/ohne-phi" (kf-hz-folge nil 0.0))
;; --- kf-dy-eingebaut: Hoehenbeitrag nach Rz(hz) und X-Massstab ---
;; waagerechter Baustein, waagerecht eingebaut -> kein Hoehengewinn
(tu-eqf "kf-dy/0-grad" 0.0 (kf-dy-eingebaut 1000.0 0.0 0.0 1.0))
;; 1000 mm unter 30 Grad -> 500 mm (sin 30 = 0.5)
(tu-eqf "kf-dy/30-grad" 500.0 (kf-dy-eingebaut 1000.0 0.0 30.0 1.0))
;; derselbe Baustein doppelt skaliert -> doppelter Hoehengewinn
(tu-eqf "kf-dy/30-grad-skaliert-2" 1000.0 (kf-dy-eingebaut 1000.0 0.0 30.0 2.0))
;; senkrecht eingebaut -> die volle Laenge als Hoehe
(tu-eqf "kf-dy/90-grad" 1000.0 (kf-dy-eingebaut 1000.0 0.0 90.0 1.0))
;; --- kf-laenge-berechnen: Hoehenbilanz nach der Laenge aufloesen ---
;; H=1000, Stationen tragen nichts bei, 30 Grad -> L = 1000/sin30 = 2000
(tu-eqf "kf-laenge/30-grad-glatt" 2000.0
(kf-laenge-berechnen 1000.0 0.0 0.0 0.0 30.0))
;; Stationen tragen 100+150 bei -> nur 750 mm bleiben fuer das Stueck
(tu-eqf "kf-laenge/mit-stationen" 1500.0
(kf-laenge-berechnen 1000.0 100.0 150.0 0.0 30.0))
;; Gegenprobe: die errechnete Laenge ergibt wieder genau H
(setq _l (kf-laenge-berechnen 1000.0 100.0 150.0 0.0 30.0))
(tu-eqf "kf-laenge/rundlauf-ergibt-H" 1000.0
(+ 100.0 150.0 (kf-dy-eingebaut _l 0.0 30.0 1.0)))
;; bereits geneigt gezeichnetes Zwischenstueck: dy-nativ wird abgezogen
;; (dy-nativ skaliert NICHT mit, nur X wird skaliert)
(tu-eqf "kf-laenge/mit-dy-nativ" 1800.0
(kf-laenge-berechnen 1000.0 0.0 0.0 (/ 100.0 (cos (/ pi 6.0))) 30.0))
;; waagerecht -> keine Hoehe erreichbar
(tu-nil "kf-laenge/0-grad-unloesbar"
(kf-laenge-berechnen 1000.0 0.0 0.0 0.0 0.0))
;; --- kf-skala-berechnen ---
(tu-eqf "kf-skala/2000-von-1000" 2.0 (kf-skala-berechnen 2000.0 1000.0))
(tu-nil "kf-skala/ohne-nativlaenge" (kf-skala-berechnen 2000.0 0.0))
(tu-nil "kf-skala/ohne-laenge" (kf-skala-berechnen nil 1000.0))
;; --- kf-laenge-pruefen: Grenzen aus der JSON ---
(tu-nil "kf-pruefen/in-ordnung" (kf-laenge-pruefen 2000.0 100.0 20000.0))
(tu-eq "kf-pruefen/zu-kurz" "kf-fehler-laenge-unter-min"
(kf-laenge-pruefen 50.0 100.0 20000.0))
(tu-eq "kf-pruefen/zu-lang" "kf-fehler-laenge-ueber-max"
(kf-laenge-pruefen 99999.0 100.0 20000.0))
;; negative Laenge = Stationen bringen mehr Hoehe mit als gefordert
(tu-eq "kf-pruefen/negativ" "kf-fehler-hoehe-zu-klein"
(kf-laenge-pruefen -10.0 100.0 20000.0))
(tu-eq "kf-pruefen/nil" "kf-fehler-winkel-null"
(kf-laenge-pruefen nil 100.0 20000.0))
;; --- kf-zahl: JSON-Wert als Zahl (Parser liefert Zahl ODER String) ---
(tu-eqf "kf-zahl/int" 26.0 (kf-zahl 26))
(tu-eqf "kf-zahl/real" 26.0 (kf-zahl 26.0))
(tu-eqf "kf-zahl/string" 26.0 (kf-zahl "26"))
(tu-nil "kf-zahl/nil" (kf-zahl nil))
;; --- kf-attrib-defs: VF-Schema + KF-Zusatz, KEIN Tag doppelt ---
(setq _defs (kf-attrib-defs))
(tu-true "kf-attrib-defs/hat-ID" (assoc "ID" _defs))
(tu-true "kf-attrib-defs/hat-FOERDERERTYP" (assoc "FOERDERERTYP" _defs))
(tu-true "kf-attrib-defs/hat-WINKEL" (assoc "WINKEL" _defs))
(tu-true "kf-attrib-defs/hat-STANDARD_STEUERUNG"
(assoc "STANDARD_STEUERUNG" _defs))
;; Reihenfolge wie im Sivas-Merkmalstamm: 361 folgt direkt auf den Typ,
;; STANDARD_STEUERUNG steht also unmittelbar hinter WINKEL
(tu-eq "kf-attrib-defs/361-folgt-auf-winkel" "STANDARD_STEUERUNG"
(car (nth (1+ (kf-tag-index "WINKEL" _defs)) _defs)))
;; FOERDERERTYP ist die BAUART im Klartext, der Winkel steht in WINKEL
(tu-eq "kf-attrib-defs/FOERDERERTYP-ist-bauart" "Schraegfoerderer Stahl"
(cadr (assoc "FOERDERERTYP" _defs)))
(tu-true "kf-attrib-defs/hat-MOVIMOT" (assoc "MOVIMOT" _defs))
;; Farbe und Antriebsmotor sind ZWEI Eigenschaften (Sivas 354 bzw. 355), nicht
;; ein kombiniertes AUSFUEHRUNG-Attribut
(tu-true "kf-attrib-defs/hat-FARBE" (assoc "FARBE" _defs))
(tu-true "kf-attrib-defs/hat-ANTRIEBSMOTOR" (assoc "ANTRIEBSMOTOR" _defs))
(tu-nil "kf-attrib-defs/kein-AUSFUEHRUNG" (assoc "AUSFUEHRUNG" _defs))
;; Der Kettenfoerderer traegt sich selbst - die Geruest-Tags aus dem
;; VF-Schema werden bewusst NICHT mitgefuehrt
(tu-nil "kf-attrib-defs/kein-GERUEST_EINZELMODUL"
(assoc "GERUEST_EINZELMODUL" _defs))
(tu-nil "kf-attrib-defs/kein-GERUEST_TYP" (assoc "GERUEST_TYP" _defs))
;; TYP/ARTINR stehen in BEIDEN Listen - der Zusatz muss gewinnen, und
;; der Tag darf nur EINMAL vorkommen (zwei ATTDEFs gleichen Tags waeren
;; im Block ungueltig, ssg-attrib-set-on traefe nur den ersten).
(tu-eq "kf-attrib-defs/TYP-ueberschrieben" "Kettenfoerderer"
(cadr (assoc "TYP" _defs)))
(setq _s 0)
(foreach _d _defs (if (= (car _d) "TYP") (setq _s (1+ _s))))
(tu-eq "kf-attrib-defs/TYP-nur-einmal" 1 _s)
(setq _s 0)
(foreach _d _defs (if (= (car _d) "ARTINR") (setq _s (1+ _s))))
(tu-eq "kf-attrib-defs/ARTINR-nur-einmal" 1 _s)
;; Der Winkel steht ALLEIN in FOERDERERTYP - kein zweites Winkel-Tag
(tu-nil "kf-attrib-defs/kein-KF_WINKEL" (assoc "KF_WINKEL" _defs))
(tu-nil "kf-attrib-defs/kein-KF_TYP" (assoc "KF_TYP" _defs))
;; Das Schema ist EIGENSTAENDIG, nicht vom VF-Streckenschema geerbt -
;; keines der VF-Tags darf durchschlagen
(tu-nil "kf-attrib-defs/kein-SEITE_AS" (assoc "SEITE_AS" _defs))
(tu-nil "kf-attrib-defs/kein-ANZAHL_VF" (assoc "ANZAHL_VF" _defs))
(tu-nil "kf-attrib-defs/kein-TEILEART" (assoc "TEILEART" _defs))
(tu-eq "kf-attrib-defs/LAYER-ist-F-3" "F-3" (cadr (assoc "LAYER" _defs)))
;; --- kf-variante-finden: ueber den Winkel, auch als String ---
(tu-eq "kf-variante-finden/26" "A"
(cdr (assoc "name"
(kf-variante-finden 26
'((("winkel" . 26) ("name" . "A"))
(("winkel" . 30) ("name" . "B")))))))
(tu-eq "kf-variante-finden/30-als-string" "B"
(cdr (assoc "name"
(kf-variante-finden 30
'((("winkel" . "26") ("name" . "A"))
(("winkel" . "30") ("name" . "B")))))))
(tu-nil "kf-variante-finden/unbekannt"
(kf-variante-finden 45 '((("winkel" . 26) ("name" . "A")))))
;; --- kf-antriebsart (Merkmal 357): Dropdown mit EINER Option ---
;; Der Wert kommt aus dem ERSTEN Listeneintrag - nicht aus dem Code.
(tu-eq "kf-antriebsart/aus-daten" "1.1 kW"
(kf-antriebsart '(("antriebsart" (("name" . "1.1 kW") ("wert" . "1.1 kW"))))))
;; eine zweite Option aendert die Vorgabe NICHT (Index 0 bleibt massgebend)
(tu-eq "kf-antriebsart/erster-eintrag-gewinnt" "1.1 kW"
(kf-antriebsart '(("antriebsart" (("name" . "1.1 kW") ("wert" . "1.1 kW"))
(("name" . "0.55 kW") ("wert" . "0.55 kW"))))))
;; Liste fehlt -> Rueckfall, aber als STRING (nicht T/nil)
(tu-eq "kf-antriebsart/ohne-eintrag" "1.1 kW" (kf-antriebsart '(("titel" . "x"))))
(tu-true "kf-antriebsart/ist-string"
(= (type (kf-antriebsart '(("titel" . "x")))) 'STR))
;; Dezimalpunkt, kein Komma (Nutzervorgabe)
(tu-nil "kf-antriebsart/kein-komma"
(vl-string-search "," (kf-antriebsart '(("titel" . "x")))))
;; --- kf-drehung-gesamt: Drehwinkel fuer KF_EDIT ---
;; Regression: der Drehwinkel wird beim Bau in die Geometrie eingerechnet,
;; die Blockreferenz selbst hat IMMER Drehung 0 (ssg-block-wrap-welt).
;; KF_EDIT las nur Gruppencode 50 und baute eine mit 90 Grad gebaute
;; Kette ungedreht neu. Der gebaute Winkel steht jetzt als XDATA.
(tu-eqf "kf-drehung/nur-xdata" 90.0 (kf-drehung-gesamt 90.0 0.0))
;; Referenz nachtraeglich von Hand um 90 Grad gedreht (Gruppencode 50 in
;; Bogenmass) -> beides addiert sich
(tu-eqf "kf-drehung/xdata-plus-referenz" 180.0
(kf-drehung-gesamt 90.0 (/ pi 2.0)))
;; Altbestand ohne XDATA: nur die Referenzdrehung (bisheriges Verhalten)
(tu-eqf "kf-drehung/ohne-xdata" 45.0 (kf-drehung-gesamt nil (/ pi 4.0)))
;; nichts bekannt -> 0, kein Absturz und kein nil
(tu-eqf "kf-drehung/nichts" 0.0 (kf-drehung-gesamt nil nil))
(tu-true "kf-drehung/ist-zahl" (numberp (kf-drehung-gesamt nil nil)))
;; Summe ueber 180 Grad wird auf -180..180 gefaltet (270 = -90)
(tu-eqf "kf-drehung/normalisiert" -90.0
(kf-drehung-gesamt 180.0 (/ pi 2.0)))
;; ganze Zahl aus der XDATA (nicht real) darf nicht abstuerzen
(tu-eqf "kf-drehung/ganzzahl" 30.0 (kf-drehung-gesamt 30 0.0))
;; --- kf-neigung-aus-punkten: Kern der 3D-Aufrichtung ---
;; Liefert (Schraeglaenge Neigungswinkel) aus Ketten-Start und -Ende.
;; Die Kette wird AUFGERICHTET eingebaut, die Hoehe laeuft also in Z.
;; 3-4-5-Dreieck: 3000 waagerecht, 4000 hoch -> 5000 schraeg
(tu-eqf "kf-neigung/3-4-5-laenge" 5000.0
(car (kf-neigung-aus-punkten '(0.0 0.0 0.0) '(3000.0 0.0 4000.0) 0.0)))
;; 45 Grad: gleiche Betraege waagerecht und hoch
(tu-eqf "kf-neigung/45-grad" 45.0
(cadr (kf-neigung-aus-punkten '(0.0 0.0 0.0) '(1000.0 0.0 1000.0) 0.0)))
;; waagerecht -> Winkel 0, Laenge = Horizontalabstand
(tu-eqf "kf-neigung/waagerecht" '(2000.0 0.0)
(kf-neigung-aus-punkten '(0.0 0.0 0.0) '(2000.0 0.0 0.0) 0.0))
;; Der Horizontalanteil wird auf die KETTENRICHTUNG projiziert, nicht
;; auf die Welt-X-Achse: bei 90 Grad Basisdrehung laeuft die Kette in Y.
;; Ohne Projektion kaeme hier 0 heraus und der Winkel waere 90 statt 45.
(tu-eqf "kf-neigung/gedreht-90" '(1414.213562 45.0)
(kf-neigung-aus-punkten '(0.0 0.0 0.0) '(0.0 1000.0 1000.0) 90.0))
;; fallende Kette -> negativer Winkel
(tu-eqf "kf-neigung/fallend" -45.0
(cadr (kf-neigung-aus-punkten '(0.0 0.0 1000.0) '(1000.0 0.0 0.0) 0.0)))
;; Start = Ende -> nil statt Division durch 0
(tu-nil "kf-neigung/nulllaenge"
(kf-neigung-aus-punkten '(5.0 5.0 5.0) '(5.0 5.0 5.0) 0.0))
;; --- kf-matrix-aufrecht: Y_lokal wird zu Z_welt ---
;; Das ist die Kernaussage der Aufrichtung. Geprueft wird sie an den
;; Bildern der Einheitsvektoren, nicht an den Matrixeintraegen - so
;; bleibt der Test lesbar und unabhaengig von der Schreibweise.
(tu-eqf "kf-matrix/Y-lokal-wird-Z-welt" '(0.0 0.0 1.0)
(mat3-mul-vec3 (kf-matrix-aufrecht 0.0 0.0) '(0.0 1.0 0.0)))
;; Die Fahrtrichtung (X) bleibt bei Basisdrehung 0 die Welt-X-Achse
(tu-eqf "kf-matrix/X-bleibt-X" '(1.0 0.0 0.0)
(mat3-mul-vec3 (kf-matrix-aufrecht 0.0 0.0) '(1.0 0.0 0.0)))
;; Basisdrehung 90 Grad dreht die Fahrtrichtung in die Welt-Y-Achse,
;; die Hoehe bleibt dabei in Z
(tu-eqf "kf-matrix/basis-90-dreht-X-nach-Y" '(0.0 1.0 0.0)
(mat3-mul-vec3 (kf-matrix-aufrecht 90.0 0.0) '(1.0 0.0 0.0)))
(tu-eqf "kf-matrix/basis-90-haelt-Z" '(0.0 0.0 1.0)
(mat3-mul-vec3 (kf-matrix-aufrecht 90.0 0.0) '(0.0 1.0 0.0)))
;; --- Standard-Variante: steht in den DATEN, nicht im Code ---
(tu-true "kf-variante-standard-p/markiert"
(kf-variante-standard-p '(("winkel" . 26) ("standard" . T))))
(tu-nil "kf-variante-standard-p/ohne-feld"
(kf-variante-standard-p '(("winkel" . 30))))
;; Index fuer die Vorauswahl - auch wenn der Standard NICHT der erste ist
(tu-eq "kf-standard-index/zweiter" 1
(kf-standard-index '((("winkel" . 26))
(("winkel" . 30) ("standard" . T)))))
(tu-eq "kf-standard-index/erster" 0
(kf-standard-index '((("winkel" . 26) ("standard" . T))
(("winkel" . 30)))))
;; keine Variante markiert -> erste, statt nil (der Dialog braucht einen Index)
(tu-eq "kf-standard-index/keiner" 0
(kf-standard-index '((("winkel" . 26)) (("winkel" . 30)))))
;; --- kf-punkt-differenzen: zweite Hoehen-Eingabeart (2 Punkte) ---
;; Gemessen wird die Differenz in Z - die Baugruppe steht aufgerichtet im
;; Modell. Zurueckgegeben wird (dz dy): die HOEHE zuerst, dY nur zur
;; Kontrolle (wer in einer Draufsicht pickt, sieht dz = 0).
(tu-eqf "kf-punkt-diff/dz" '(1500.0 0.0)
(kf-punkt-differenzen '(0.0 0.0 0.0) '(2000.0 0.0 1500.0)))
;; Vorzeichen egal - die Reihenfolge der Punkte darf keine Rolle spielen
(tu-eqf "kf-punkt-diff/umgekehrt" '(1500.0 0.0)
(kf-punkt-differenzen '(2000.0 0.0 1500.0) '(0.0 0.0 0.0)))
;; in einer Draufsicht gepickt: dz = 0, dY gross
(tu-eqf "kf-punkt-diff/draufsicht" '(0.0 1200.0)
(kf-punkt-differenzen '(0.0 0.0 0.0) '(3000.0 1200.0 0.0)))
;; Punkte ohne Z (2D-Pick) duerfen nicht abstuerzen: dz ist dann 0
(tu-eqf "kf-punkt-diff/ohne-z" '(0.0 800.0)
(kf-punkt-differenzen '(0.0 0.0) '(100.0 800.0)))
(tu-nil "kf-punkt-diff/nil" (kf-punkt-differenzen nil '(1.0 2.0 3.0)))
;; --- kf-auswahl-wert: "wert" vor "name", Vorgabe bei leerem Index ---
(tu-eq "kf-auswahl-wert/wert" "Nein"
(kf-auswahl-wert '((("name" . "Nein") ("wert" . "Nein"))) 0 "X"))
(tu-eq "kf-auswahl-wert/ausserhalb" "X"
(kf-auswahl-wert '((("name" . "Nein") ("wert" . "Nein"))) 5 "X"))
)
)
)
(defun c:TEST_UNIT ( / out-dir report)
(tu-reset)
(princ "\n================================================================")
(princ "\n TEST_UNIT - LISP-Standardfunktionen")
(princ "\n================================================================")
(foreach fn '("tu-tests-core" "tu-tests-lang" "tu-tests-id" "tu-tests-vfcore"
"tu-tests-etage" "tu-tests-vfl-es" "tu-tests-vfl-parallel"
"tu-tests-vfl-ziellinie"
"tu-tests-export" "tu-tests-hoehen" "tu-tests-gf" "tu-tests-omni" "tu-tests-kreisel" "tu-tests-kreisel-bp"
"tu-tests-sepliste" "tu-tests-json" "tu-tests-geruest"
"tu-tests-sepscan" "tu-tests-vfl-segs" "tu-tests-vfl-abbruch"
"tu-tests-werkzeuge" "tu-tests-kf")
(tu-run-block fn))
(princ "\n\n----------------------------------------------------------------")
(princ (strcat "\n Gesamt: " (itoa (+ *tu-pass* *tu-fail*))
" | PASS: " (itoa *tu-pass*)
" | FAIL: " (itoa *tu-fail*)))
(princ (if (= *tu-fail* 0) "\n ERGEBNIS: ALLE TESTS BESTANDEN" "\n ERGEBNIS: TESTS FEHLGESCHLAGEN"))
(princ "\n----------------------------------------------------------------")
;; Report-Datei schreiben (fuer run_tests.bat --lisp)
(setq out-dir (strcat (getenv "DXFMAKRO") "/tests/output"))
(vl-mkdir out-dir)
(setq report (strcat out-dir "/unit_results.txt"))
(if (tu-write-report report)
(princ (strcat "\n Report: " report))
(princ "\n WARNUNG: Report konnte nicht geschrieben werden.")
)
(princ)
)
(princ "\ntest_unit.lsp geladen. Befehl: TEST_UNIT")
(princ)
Reference in New Issue View Git Blame Copy Permalink