Schoenenberger_Systeme_GmbH/dxfmakros
7
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'goh-storage'

Browse Source
This commit is contained in:
Simon Hensch
2026-10-30 13:36:54 +01:00
parent 61372e9104 5821619e12
commit d9043ebca5
26 changed files with 5919 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/test_unit.lsp
+436 -1
View File
@@ -3066,6 +3066,441 @@
;; ------------------------------------------------------------
;; TESTS: ssg_core.lsp - Polygon-Helfer (reine 2D-Berechnung)
;; ------------------------------------------------------------
(defun tu-tests-poly ( / _q _u _l)
(princ "\n[ssg_core Polygon]")
(setq _q '((0.0 0.0) (10.0 0.0) (10.0 5.0) (0.0 5.0)))
(tu-eqf "ssg-poly-flaeche/rechteck" 50.0 (ssg-poly-flaeche _q))
(tu-eqf "ssg-poly-flaeche/gegen-uhrzeiger" 50.0 (ssg-poly-flaeche (reverse _q)))
(tu-eqf "ssg-poly-umfang" 30.0 (ssg-poly-umfang _q))
(tu-eq "ssg-poly-kanten/anzahl" 4 (length (ssg-poly-kanten _q)))
(tu-eq "ssg-poly-kanten/doppelter-schlusspunkt" 4
(length (ssg-poly-kanten (append _q (list (car _q))))))
(tu-eqf "ssg-poly-bbox" '((0.0 0.0) (10.0 5.0)) (ssg-poly-bbox _q))
(tu-true "ssg-punkt-in-poly-p/innen" (ssg-punkt-in-poly-p '(5.0 2.0) _q))
(tu-nil "ssg-punkt-in-poly-p/aussen" (ssg-punkt-in-poly-p '(11.0 2.0) _q))
;; U-Form: Schnitt durch beide Schenkel
(setq _u '((0.0 0.0) (10.0 0.0) (10.0 10.0) (7.0 10.0) (7.0 3.0) (3.0 3.0) (3.0 10.0) (0.0 10.0)))
(tu-eqf "ssg-poly-flaeche/u-form" 72.0 (ssg-poly-flaeche _u))
(tu-nil "ssg-punkt-in-poly-p/u-luecke" (ssg-punkt-in-poly-p '(5.0 5.0) _u))
(tu-eqf "ssg-poly-schnitt-y/u-schenkel" '((0.0 3.0) (7.0 10.0)) (ssg-poly-schnitt-y _u 5.0))
(tu-eqf "ssg-poly-schnitt-y/u-boden" '((0.0 10.0)) (ssg-poly-schnitt-y _u 1.0))
(tu-eqf "ssg-poly-schnitt-y/unterkante" '((0.0 10.0)) (ssg-poly-schnitt-y _q 0.0))
(tu-nil "ssg-poly-schnitt-y/oberkante" (ssg-poly-schnitt-y _q 5.0))
(tu-eqf "ssg-intervalle-schnitt" '((2.0 3.0) (5.0 10.0))
(ssg-intervalle-schnitt '((0.0 10.0)) '((2.0 3.0) (5.0 12.0))))
(tu-nil "ssg-intervalle-schnitt/leer" (ssg-intervalle-schnitt '((0.0 1.0)) '((2.0 3.0))))
(tu-eqf "ssg-intervalle-minus" '((0.0 2.0) (3.0 5.0) (6.0 10.0))
(ssg-intervalle-minus '((0.0 10.0)) '((2.0 3.0) (5.0 6.0))))
(tu-eqf "ssg-intervalle-minus/ohne-b" '((0.0 10.0)) (ssg-intervalle-minus '((0.0 10.0)) nil))
(tu-eqf "ssg-intervalle-minus/ueberdeckt" nil (ssg-intervalle-minus '((2.0 3.0)) '((0.0 10.0))))
(tu-eqf "ssg-punkt-drehen/90" '(0.0 1.0) (ssg-punkt-drehen '(1.0 0.0) (/ pi 2.0) '(0.0 0.0)))
(tu-eqf "ssg-punkt-drehen/z-bleibt" '(1.0 2.0 7.0) (ssg-punkt-drehen '(1.0 2.0 7.0) 0.0 '(5.0 5.0)))
;; Umlaufsinn
(tu-eqf "ssg-poly-flaeche-signiert/ccw" 50.0 (ssg-poly-flaeche-signiert _q))
(tu-eqf "ssg-poly-flaeche-signiert/cw" -50.0 (ssg-poly-flaeche-signiert (reverse _q)))
;; Band-Clip: x-Ausdehnung des Polygonteils zwischen zwei Waagrechten
(tu-eqf "ssg-poly-band-x/rechteck" '(0.0 10.0) (ssg-poly-band-x _q 1.0 2.0))
(tu-eqf "ssg-poly-band-x/dreieck-unten" '(0.0 10.0) (ssg-poly-band-x '((0.0 0.0) (10.0 0.0) (0.0 10.0)) 0.0 5.0))
(tu-eqf "ssg-poly-band-x/dreieck-oben" '(0.0 5.0) (ssg-poly-band-x '((0.0 0.0) (10.0 0.0) (0.0 10.0)) 5.0 10.0))
(tu-nil "ssg-poly-band-x/ausserhalb" (ssg-poly-band-x _q 6.0 7.0))
;; nur an der Kante beruehrt -> sperrt nicht
(tu-nil "ssg-poly-band-x/kante" (ssg-poly-band-x _q 5.0 6.0))
)
;; ------------------------------------------------------------
;; TESTS: LagerInsert.lsp / LagerPruefung.lsp - reine Funktionen
;; (Geschoss-/Bereichsbloecke, Export und Dialoge brauchen eine Zeichnung:
;; tests/test_lager.lsp)
;; ------------------------------------------------------------
(defun tu-lg-anzahl (recs typ)
(length (vl-remove-if-not '(lambda (r) (= (car r) typ)) recs))
)
(defun tu-lg-summe (recs typ / s)
(setq s 0.0)
(foreach r recs
(if (= (car r) typ) (setq s (+ s (distance (cadr r) (caddr r))))))
s
)
(defun tu-tests-lager ( / _q _erg _l _kand _kand2 _sq0 _sq3 _regel _prof _rand _rs _tab _w)
(princ "\n[LagerInsert / LagerPruefung]")
(if (not (and (car (atoms-family 1 '("LG-FUELLUNG-BERECHNEN")))
(car (atoms-family 1 '("LG-REGEL-AUFLOESEN")))))
(tu-record nil "lager/geladen" "LagerInsert/LagerPruefung nicht geladen (ssg_load.lsp)")
(progn
;; --- Zahlen/Texte ---
(tu-eq "lg-mm-str/ganz" "2300" (lg-mm-str 2300.0))
(tu-eq "lg-mm-str/halb" "2.5" (lg-mm-str 2.5))
(tu-eq "lg-mm-str/negativ" "-1" (lg-mm-str -1.0))
(tu-eq "lg-mm-str/nil" "" (lg-mm-str nil))
(tu-eqf "lg-zahl/komma" 1.5 (lg-zahl "1,5"))
(tu-nil "lg-zahl/leer" (lg-zahl ""))
(tu-nil "lg-zahl/text" (lg-zahl "abc"))
(tu-eqf "lg-haengeebenen-parse" '((2300.0 1200.0) (1100.0 1100.0))
(lg-haengeebenen-parse "2300/1200;1100/1100"))
(tu-eqf "lg-haengeebenen-parse/ohne-ware" '((2300.0 0.0)) (lg-haengeebenen-parse "2300"))
(tu-nil "lg-haengeebenen-parse/ungueltig" (lg-haengeebenen-parse "x"))
(tu-eq "lg-haengeebenen-string" "2300/1200;1100/1100"
(lg-haengeebenen-string '((2300.0 1200.0) (1100.0 1100.0))))
(tu-eq "lg-haengeebenen-n/1" "2300/1200" (lg-haengeebenen-n "2300/1200;1100/1100" 1))
(tu-eq "lg-haengeebenen-n/zuviel" "2300/1200;1100/1100" (lg-haengeebenen-n "2300/1200;1100/1100" 5))
(tu-eq "lg-feld-pruefen/mm" "1000" (lg-feld-pruefen "mm" " 1000 "))
(tu-nil "lg-feld-pruefen/mm-neg" (lg-feld-pruefen "mm" "-5"))
(tu-nil "lg-feld-pruefen/mm-leer" (lg-feld-pruefen "mm" ""))
(tu-eq "lg-feld-pruefen/mm_leer" "" (lg-feld-pruefen "mm_leer" ""))
(tu-eq "lg-feld-pruefen/int" "2" (lg-feld-pruefen "int" "2"))
(tu-nil "lg-feld-pruefen/int-0" (lg-feld-pruefen "int" "0"))
(tu-eq "lg-feld-pruefen/int0-0" "0" (lg-feld-pruefen "int0" "0"))
(tu-nil "lg-feld-pruefen/int-bruch" (lg-feld-pruefen "int" "1.5"))
(tu-eq "lg-feld-pruefen/grad-neg" "-90" (lg-feld-pruefen "grad" "-90"))
(tu-eq "lg-feld-pruefen/ebenen" "2300/1200;1100/1100" (lg-feld-pruefen "ebenen" "2300/1200; 1100/1100"))
(tu-nil "lg-feld-pruefen/ebenen-leer" (lg-feld-pruefen "ebenen" ""))
(tu-eq "lg-layer-name/geschoss" "LG_Reihe_G2" (lg-layer-name "LG_Reihe" "2"))
(tu-eq "lg-layer-name/int" "LG_Reihe_G3" (lg-layer-name "LG_Reihe" 3))
(tu-eq "lg-layer-name/ohne" "LG_Reihe" (lg-layer-name "LG_Reihe" nil))
;; --- Auto-Fuellung: Rechteck 10000 x 6000, Gang 1000, Tiefe 700 ---
(setq _q '((0.0 0.0) (10000.0 0.0) (10000.0 6000.0) (0.0 6000.0)))
;; 2 Reihen je Gang: Modul 700+1000+700 = 2400 -> 2 Module, Rest 1200
(setq _erg (lg-fuellung-berechnen _q (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2))))
(tu-eq "lg-fuellung/2je-reihen" 4 (tu-lg-anzahl (car _erg) "reihe"))
(tu-eq "lg-fuellung/2je-gaenge" 2 (tu-lg-anzahl (car _erg) "gang"))
(tu-eq "lg-fuellung/2je-module" 2 (caddr _erg))
(tu-eqf "lg-fuellung/2je-rest" 1200.0 (cadr _erg))
(tu-eqf "lg-fuellung/2je-reihenlaenge" 40000.0 (tu-lg-summe (car _erg) "reihe"))
(tu-eqf "lg-fuellung/erste-reihe" '("reihe" (0.0 350.0) (10000.0 350.0) 700.0) (car (car _erg)))
(tu-eqf "lg-fuellung/erster-gang" '("gang" (0.0 1200.0) (10000.0 1200.0) 1000.0) (cadr (car _erg)))
;; Ruecken an Ruecken: 3. Reihe (Modul 1) direkt nach der 2. Reihe
(tu-eqf "lg-fuellung/ruecken-an-ruecken" '(0.0 2050.0) (cadr (nth 2 (car _erg))))
(tu-eqf "lg-fuellung/zweites-modul" '(0.0 2750.0) (cadr (nth 3 (car _erg))))
;; 1 Reihe je Gang: Modul 1700 -> 3 Module, Rest 900
(setq _erg (lg-fuellung-berechnen _q (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 1))))
(tu-eq "lg-fuellung/1je-reihen" 3 (tu-lg-anzahl (car _erg) "reihe"))
(tu-eq "lg-fuellung/1je-gaenge" 3 (tu-lg-anzahl (car _erg) "gang"))
(tu-eqf "lg-fuellung/1je-rest" 900.0 (cadr _erg))
;; Quergaenge alle 4000 mm, 1000 breit, ein Modul (Hoehe 2400)
(tu-eqf "lg-quergang-luecken" '((4000.0 5000.0) (9000.0 10000.0))
(lg-quergang-luecken 0.0 10000.0 4000.0 1000.0 0.0))
;; keine Luecke am Reihenende, wenn dahinter kein Mindeststueck passt
(tu-eqf "lg-quergang-luecken/reihenende" '((4000.0 5000.0))
(lg-quergang-luecken 0.0 10000.0 4000.0 1000.0 500.0))
(tu-nil "lg-quergang-luecken/aus" (lg-quergang-luecken 0.0 10000.0 0.0 1000.0 500.0))
(setq _erg (lg-fuellung-berechnen '((0.0 0.0) (10000.0 0.0) (10000.0 2400.0) (0.0 2400.0))
(list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2)
(cons "q_abstand" 4000.0) (cons "q_breite" 1000.0))))
;; Luecke 4000-5000; die zweite (9000-10000) entfaellt am Reihenende
(tu-eq "lg-fuellung/quer-reihenstuecke" 4 (tu-lg-anzahl (car _erg) "reihe"))
(tu-eqf "lg-fuellung/quer-reihenlaenge" 18000.0 (tu-lg-summe (car _erg) "reihe"))
(tu-eq "lg-fuellung/quer-hauptgang-durch" 1 (tu-lg-anzahl (car _erg) "gang"))
(tu-eqf "lg-fuellung/quer-hauptganglaenge" 10000.0 (tu-lg-summe (car _erg) "gang"))
;; zwei Stuecke (unter und ueber dem Hauptgang), je 700 lang
(tu-eq "lg-fuellung/quergaenge" 2 (tu-lg-anzahl (car _erg) "quergang"))
(tu-eqf "lg-fuellung/quergang-laenge" 1400.0 (tu-lg-summe (car _erg) "quergang"))
;; L-Form: oberes Modul nur halb so lang
(setq _l '((0.0 0.0) (10000.0 0.0) (10000.0 2400.0) (5000.0 2400.0) (5000.0 4800.0) (0.0 4800.0)))
(setq _erg (lg-fuellung-berechnen _l (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2))))
(tu-eqf "lg-fuellung/l-form-reihenlaenge" 30000.0 (tu-lg-summe (car _erg) "reihe"))
(tu-eqf "lg-fuellung/l-form-ganglaenge" 15000.0 (tu-lg-summe (car _erg) "gang"))
;; Kontur kleiner als ein Modul -> nichts, Rest = ganze Breite
(setq _erg (lg-fuellung-berechnen '((0.0 0.0) (5000.0 0.0) (5000.0 2000.0) (0.0 2000.0))
(list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2))))
(tu-nil "lg-fuellung/zu-schmal" (car _erg))
(tu-eqf "lg-fuellung/zu-schmal-rest" 2000.0 (cadr _erg))
(tu-eqf "lg-kontur-richtung/waagrecht" 0.0 (lg-kontur-richtung _q))
(tu-eqf "lg-kontur-richtung/senkrecht" 90.0
(lg-kontur-richtung '((0.0 0.0) (1000.0 0.0) (1000.0 8000.0) (0.0 8000.0))))
;; --- Randgaenge (Himmelsrichtung, entlang der Konturkanten) ---
(tu-eq "lg-kompass/ost" "O" (lg-kompass 0.0))
(tu-eq "lg-kompass/nord" "N" (lg-kompass (/ pi 2.0)))
(tu-eq "lg-kompass/west" "W" (lg-kompass pi))
(tu-eq "lg-kompass/sued" "S" (lg-kompass (/ pi -2.0)))
(tu-eq "lg-kompass/diagonal-ns" "N" (lg-kompass (/ pi 4.0)))
(setq _rand '(("N" . 1000.0) ("O" . 1000.0) ("S" . 1000.0) ("W" . 1000.0)))
;; Rechteck, alle vier Seiten: N/S volle Laenge, O/W um 2 x 1000 gekuerzt
(setq _rs (lg-randgang-streifen _q 0.0 _rand 100.0))
(tu-eq "lg-randgang/rechteck-anzahl" 4 (length _rs))
(tu-eq "lg-randgang/rechteck-sued" "S" (car (car _rs)))
(tu-eqf "lg-randgang/rechteck-sued-mitte" '((0.0 500.0) (10000.0 500.0))
(list (cadr (car _rs)) (caddr (car _rs))))
(tu-eqf "lg-randgang/rechteck-ost-gekuerzt" '((9500.0 1000.0) (9500.0 5000.0))
(list (cadr (cadr _rs)) (caddr (cadr _rs))))
(setq _erg (lg-fuellung-berechnen _q (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2)
(cons "rand" _rand))))
(tu-eqf "lg-fuellung/rand-laenge" 28000.0 (tu-lg-summe (car _erg) "randgang"))
;; Stapel 1000..5000 -> ein Modul, Rest 1600; Reihen/Gang 1000..9000
(tu-eq "lg-fuellung/rand-module" 1 (caddr _erg))
(tu-eqf "lg-fuellung/rand-rest" 1600.0 (cadr _erg))
(tu-eqf "lg-fuellung/rand-erste-reihe" '("reihe" (1000.0 1350.0) (9000.0 1350.0) 700.0) (car (car _erg)))
(tu-eqf "lg-fuellung/rand-reihenlaenge" 16000.0 (tu-lg-summe (car _erg) "reihe"))
(tu-eqf "lg-fuellung/rand-ganglaenge" 8000.0 (tu-lg-summe (car _erg) "gang"))
(tu-eq "lg-fuellung/rand-am-ende" "randgang" (car (last (car _erg))))
;; RICHTUNG 90 Grad: Nord liegt auf der lokalen rechten Kante (Reihenende)
(setq _rs (lg-randgang-streifen _q (/ pi 2.0) '(("N" . 1000.0)) 100.0))
(tu-eq "lg-randgang/gedreht-anzahl" 1 (length _rs))
(tu-eqf "lg-randgang/gedreht-lage" '((9500.0 0.0) (9500.0 6000.0))
(list (cadr (car _rs)) (caddr (car _rs))))
(setq _erg (lg-fuellung-berechnen _q (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2)
(cons "rand" '(("N" . 1000.0))) (cons "richtung" (/ pi 2.0)))))
(tu-eqf "lg-fuellung/gedreht-reihenlaenge" 36000.0 (tu-lg-summe (car _erg) "reihe"))
(tu-eqf "lg-fuellung/gedreht-rest" 1200.0 (cadr _erg))
;; L-Form, Nord + Ost: Stufenkante bekommt den Nord-Randgang und wird
;; an der Innenecke um die Ost-Breite verlaengert; Ost-Gaenge an den
;; konvexen Ecken gekuerzt
(setq _rs (lg-randgang-streifen _l 0.0 '(("N" . 1000.0) ("O" . 1000.0)) 100.0))
(tu-eq "lg-randgang/l-anzahl" 4 (length _rs))
(tu-eq "lg-randgang/l-nordkanten" 2
(length (vl-remove-if-not '(lambda (s) (= (car s) "N")) _rs)))
(tu-eqf "lg-randgang/l-stufe-verlaengert" '((10000.0 1900.0) (4000.0 1900.0))
(list (cadr (nth 1 _rs)) (caddr (nth 1 _rs))))
(setq _erg (lg-fuellung-berechnen _l (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2)
(cons "rand" '(("N" . 1000.0) ("O" . 1000.0))))))
(tu-eqf "lg-fuellung/l-rand-laenge" 13800.0 (tu-lg-summe (car _erg) "randgang"))
(tu-eqf "lg-fuellung/l-reihenlaenge" 13000.0 (tu-lg-summe (car _erg) "reihe"))
(tu-eqf "lg-fuellung/l-ganglaenge" 4000.0 (tu-lg-summe (car _erg) "gang"))
;; Sperrrechteck (manueller Gang) quer durch die Reihen
(setq _erg (lg-fuellung-berechnen _q (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2)
(cons "sperr" '(((4000.0 0.0) (5000.0 0.0) (5000.0 6000.0) (4000.0 6000.0)))))))
(tu-eq "lg-fuellung/sperr-reihenstuecke" 8 (tu-lg-anzahl (car _erg) "reihe"))
(tu-eqf "lg-fuellung/sperr-reihenlaenge" 36000.0 (tu-lg-summe (car _erg) "reihe"))
(tu-eqf "lg-fuellung/sperr-ganglaenge" 18000.0 (tu-lg-summe (car _erg) "gang"))
;; Reststuecke unter min_reihe fallen weg, Gangstuecke ab min_gang bleiben
(setq _erg (lg-fuellung-berechnen _q (list (cons "gang" 1000.0) (cons "tiefe" 700.0) (cons "reihen" 2)
(cons "sperr" '(((0.0 0.0) (9700.0 0.0) (9700.0 6000.0) (0.0 6000.0)))))))
(tu-eq "lg-fuellung/sperr-reststueck" 0 (tu-lg-anzahl (car _erg) "reihe"))
(tu-eq "lg-fuellung/sperr-gangstueck" 2 (tu-lg-anzahl (car _erg) "gang"))
;; --- Schraffur je Belag, Gang-Blockname ---
(setq _tab (ssg-json-parse
"{\"spanplatte\": {\"muster\": \"ANSI31\", \"massstab\": 50}, \"hallenboden\": null}"))
(tu-eqf "lg-schraffur-vorgabe/spanplatte" '("ANSI31" 50.0 0.0) (lg-schraffur-vorgabe "spanplatte" _tab))
(tu-nil "lg-schraffur-vorgabe/hallenboden" (lg-schraffur-vorgabe "hallenboden" _tab))
(tu-nil "lg-schraffur-vorgabe/unbekannt" (lg-schraffur-vorgabe "beton" _tab))
(tu-nil "lg-schraffur-vorgabe/nil" (lg-schraffur-vorgabe nil _tab))
(tu-eq "lg-gang-blockname/belag" "LG_GANG_12000_1000_SPANPLATTE"
(lg-gang-blockname 12000.0 1000.0 "spanplatte"))
(tu-eq "lg-gang-blockname/ohne" "LG_GANG_12000_1000" (lg-gang-blockname 12000.0 1000.0 ""))
;; --- Geschosszuordnung ---
(setq _sq0 '((0.0 0.0 0.0) (100.0 0.0 0.0) (100.0 100.0 0.0) (0.0 100.0 0.0))
_sq3 '((0.0 0.0 3100.0) (100.0 0.0 3100.0) (100.0 100.0 3100.0) (0.0 100.0 3100.0)))
(tu-eq "lg-geschoss-punkt/einzeln" 1
(lg-geschoss-fuer-punkt-kern '(50.0 50.0 0.0) (list (list 1 0.0 _sq0))))
(tu-nil "lg-geschoss-punkt/aussen"
(lg-geschoss-fuer-punkt-kern '(150.0 50.0 0.0) (list (list 1 0.0 _sq0))))
;; 2D: beide Konturen auf Z=0 uebereinander -> nicht eindeutig
(tu-nil "lg-geschoss-punkt/2d-mehrdeutig"
(lg-geschoss-fuer-punkt-kern '(50.0 50.0 0.0) (list (list 1 0.0 _sq0) (list 2 3100.0 _sq0))))
;; 3D: Konturen auf ihrer Belagshoehe -> Z entscheidet
(setq _kand (list (list 1 0.0 _sq0) (list 2 3100.0 _sq3)))
(tu-eq "lg-geschoss-punkt/3d-oben" 2 (lg-geschoss-fuer-punkt-kern '(50.0 50.0 3200.0) _kand))
(tu-eq "lg-geschoss-punkt/3d-unten" 1 (lg-geschoss-fuer-punkt-kern '(50.0 50.0 100.0) _kand))
;; --- Geschoss kopieren ---
(tu-eq "lg-geschoss-aus-layer/regal" 2 (lg-geschoss-aus-layer "LG_Regal_G2"))
(tu-eq "lg-geschoss-aus-layer/12" 12 (lg-geschoss-aus-layer "LG_Reihe_G12"))
(tu-nil "lg-geschoss-aus-layer/ohne" (lg-geschoss-aus-layer "LG_Reihe"))
(tu-nil "lg-geschoss-aus-layer/0" (lg-geschoss-aus-layer "0"))
(tu-nil "lg-geschoss-aus-layer/suffix" (lg-geschoss-aus-layer "LG_X_G2a"))
(tu-nil "lg-geschoss-aus-layer/nil" (lg-geschoss-aus-layer nil))
;; 2D uebereinander: Kontur mehrdeutig, Layer entscheidet
(setq _kand2 (list (list 1 0.0 _sq0) (list 2 3100.0 _sq0)))
(tu-eq "lg-rack-geschoss/layer" 2 (lg-rack-geschoss "LG_Regal_G2" '(50.0 50.0 0.0) _kand2))
(tu-nil "lg-rack-geschoss/mehrdeutig" (lg-rack-geschoss "0" '(50.0 50.0 0.0) _kand2))
(tu-eq "lg-rack-geschoss/kontur" 1 (lg-rack-geschoss "0" '(50.0 50.0 0.0) (list (list 1 0.0 _sq0))))
;; Layer eines nicht vorhandenen Geschosses zaehlt nicht
(tu-eq "lg-rack-geschoss/layer-fremd" 1 (lg-rack-geschoss "LG_Regal_G7" '(50.0 50.0 0.0) (list (list 1 0.0 _sq0))))
(tu-eq "lg-kopie-belag/folgt" "spanplatte" (lg-kopie-belag "hallenboden" "hallenboden" "spanplatte"))
(tu-eq "lg-kopie-belag/eigen" "gitterrost" (lg-kopie-belag "gitterrost" "hallenboden" "spanplatte"))
(tu-nil "lg-kopie-belag/nil" (lg-kopie-belag nil "hallenboden" "spanplatte"))
(setq _w (lg-kopie-werte '(("ID" . "2A") ("GESCHOSS" . "1") ("LAYER" . "LG_Gang_G1") ("LAENGE" . "9000")
("BREITE_mm" . "1000") ("ART" . "gang") ("BELAG" . "hallenboden")
("BEREICH" . "3") ("QUELLE" . "manuell"))
2 5 "hallenboden" "spanplatte"))
(tu-eq "lg-kopie-werte/gang"
'(("GESCHOSS" . "2") ("BEREICH" . "5") ("BREITE_mm" . "1000") ("ART" . "gang")
("BELAG" . "spanplatte") ("QUELLE" . "manuell"))
_w)
(tu-eq "lg-kopie-werte/ohne-bereich" "" (cdr (assoc "BEREICH" (lg-kopie-werte '(("BEREICH" . "3")) 2 nil nil nil))))
(tu-eqf "lg-kopie-plan/2d"
'((1 3000.0 (0.0 0.0 0.0)) (2 6000.0 (0.0 0.0 0.0)))
(lg-kopie-plan 0.0 3000.0 2 0.0 0.0 nil))
(tu-eqf "lg-kopie-plan/versatz-3d"
'((1 6100.0 (20000.0 0.0 3000.0)) (2 9100.0 (40000.0 0.0 6000.0)))
(lg-kopie-plan 3100.0 3000.0 2 20000.0 0.0 T))
(tu-eqf "lg-kopie-abstand/unten" 3100.0 (lg-kopie-abstand-vorgabe 6200.0 3100.0 nil nil))
(tu-eqf "lg-kopie-abstand/lichte" 3000.0 (lg-kopie-abstand-vorgabe 0.0 nil 2750.0 250.0))
(tu-nil "lg-kopie-abstand/nichts" (lg-kopie-abstand-vorgabe 0.0 nil nil 250.0))
(tu-nil "lg-kopie-3d-p/2d" (lg-kopie-3d-p _kand2))
(tu-eq "lg-kopie-3d-p/3d" T (lg-kopie-3d-p _kand))
(tu-eq "lg-feld-pruefen/mm_vz" "-1500" (lg-feld-pruefen "mm_vz" "-1500"))
(tu-nil "lg-feld-pruefen/mm_vz-x" (lg-feld-pruefen "mm_vz" "abc"))
(tu-nil "lg-feld-pruefen/mm_vz-leer" (lg-feld-pruefen "mm_vz" ""))
;; --- Gang aus Rechteck ---
(tu-eqf "lg-gang-aus-ecken/quer"
'((0.0 500.0 0.0) (4000.0 500.0 0.0) 1000.0)
(lg-gang-aus-ecken '((0.0 0.0 0.0) (4000.0 0.0 0.0) (4000.0 1000.0 0.0) (0.0 1000.0 0.0))))
;; hochkant, Ecken gegen den Uhrzeigersinn ab oben rechts, Z uebernommen
(tu-eqf "lg-gang-aus-ecken/hoch"
'((600.0 5000.0 3100.0) (600.0 0.0 3100.0) 1200.0)
(lg-gang-aus-ecken '((1200.0 5000.0 3100.0) (0.0 5000.0 3100.0) (0.0 0.0 3100.0) (1200.0 0.0 3100.0))))
;; Breite auf ganze mm
(tu-eqf "lg-gang-aus-ecken/runden" 900.0
(caddr (lg-gang-aus-ecken '((0.0 0.0) (3000.0 0.0) (3000.0 899.6) (0.0 899.6)))))
;; Rundung verschiebt nur die Seite gegenueber der ersten Ecke
(tu-eqf "lg-gang-aus-ecken/rundung-erste-ecke-unten"
'((0.0 450.0 0.0) (3000.0 450.0 0.0) 900.0)
(lg-gang-aus-ecken '((0.0 0.0) (3000.0 0.0) (3000.0 899.6) (0.0 899.6))))
(tu-eqf "lg-gang-aus-ecken/rundung-erste-ecke-oben"
'((0.0 449.6 0.0) (3000.0 449.6 0.0) 900.0)
(lg-gang-aus-ecken '((0.0 899.6) (3000.0 899.6) (3000.0 0.0) (0.0 0.0))))
;; erste Ecke rechts: Linie beginnt an der rechten Querseite
(tu-eqf "lg-gang-aus-ecken/start-an-erster-ecke"
'((3000.0 450.0 0.0) (0.0 450.0 0.0) 900.0)
(lg-gang-aus-ecken '((3000.0 0.0) (0.0 0.0) (0.0 899.6) (3000.0 899.6))))
;; gedreht (UCS 90 Grad): laengere Seite bestimmt die Richtung
(tu-eqf "lg-gang-aus-ecken/gedreht"
'((-500.0 0.0 0.0) (-500.0 4000.0 0.0) 1000.0)
(lg-gang-aus-ecken '((0.0 0.0 0.0) (0.0 4000.0 0.0) (-1000.0 4000.0 0.0) (-1000.0 0.0 0.0))))
;; --- Zuschnitt durch von Hand gesetzte Objekte ---
;; Reihe 10000 x 700, Gang 1000 breit quer darueber -> zwei Reste
(tu-eqf "lg-linie-zuschnitt/quer" '((0.0 4500.0) (5500.0 10000.0))
(lg-linie-zuschnitt 10000.0 700.0
'(((4500.0 -2000.0) (5500.0 -2000.0) (5500.0 2000.0) (4500.0 2000.0))) 500.0))
;; Gang liegt nur an der Laengsseite an -> nichts zu schneiden
(tu-eq "lg-linie-zuschnitt/anliegend" 'unveraendert
(lg-linie-zuschnitt 10000.0 700.0
'(((0.0 350.0) (10000.0 350.0) (10000.0 1350.0) (0.0 1350.0))) 500.0))
(tu-eq "lg-linie-zuschnitt/weit-weg" 'unveraendert
(lg-linie-zuschnitt 10000.0 700.0
'(((20000.0 -500.0) (21000.0 -500.0) (21000.0 500.0) (20000.0 500.0))) 500.0))
(tu-nil "lg-linie-zuschnitt/ganz-ueberdeckt"
(lg-linie-zuschnitt 4000.0 700.0
'(((-100.0 -500.0) (4100.0 -500.0) (4100.0 500.0) (-100.0 500.0))) 500.0))
;; Rest 300 < Mindestlaenge 500 faellt weg
(tu-nil "lg-linie-zuschnitt/rest-zu-kurz"
(lg-linie-zuschnitt 10000.0 700.0
'(((300.0 -500.0) (10000.0 -500.0) (10000.0 500.0) (300.0 500.0))) 500.0))
(tu-eq "lg-quelle-rang" '(2 1 0 0)
(mapcar 'lg-quelle-rang '("manuell" "auto_geaendert" "auto" nil)))
;; --- goh_rack-Erkennung: Parameterwerte, Namen, Transformationen ---
(tu-eqf "lg-zahl-einheit/mm" 700.0 (lg-zahl-einheit "700 mm"))
(tu-eqf "lg-zahl-einheit/cm" 718.752 (lg-zahl-einheit "71.8752 cm"))
(tu-eqf "lg-zahl-einheit/m" 12900.0 (lg-zahl-einheit "12,9 m"))
(tu-eqf "lg-zahl-einheit/ohne" 2.0 (lg-zahl-einheit "2"))
(tu-eqf "lg-zahl-einheit/zahl" 3.0 (lg-zahl-einheit 3))
(tu-nil "lg-zahl-einheit/km" (lg-zahl-einheit "5 km"))
(tu-nil "lg-zahl-einheit/text" (lg-zahl-einheit "abc"))
(tu-nil "lg-zahl-einheit/leer" (lg-zahl-einheit ""))
(tu-nil "lg-zahl-einheit/nil" (lg-zahl-einheit nil))
(tu-eqf "lg-racks-auswerten"
'((1 2 3000.0 6000.0) (2 1 500.0 1500.0) (nil 2 700.0 1400.0))
(lg-racks-auswerten '((2 500.0 3.0) (nil 700.0 2.0) (1 1000.0 2.0)
(1 2000.0 2.0) (nil nil 2.0))))
(tu-nil "lg-racks-auswerten/leer" (lg-racks-auswerten nil))
(tu-eq "lg-name-brauchbar-p/name" T (lg-name-brauchbar-p "goh_rack"))
(tu-nil "lg-name-brauchbar-p/anonym" (lg-name-brauchbar-p "*U29"))
(tu-nil "lg-name-brauchbar-p/leer" (lg-name-brauchbar-p ""))
;; Einfuegung bei (100,0), 90 Grad, x-Skalierung 2: lokales (1,0,0) -> (100,2,0)
(tu-eqf "lg-insert-tf/drehung-skalierung" '(100.0 2.0 0.0)
(lg-tf-pkt (lg-insert-tf (list '(2 . "TU_KEIN_BLOCK") '(10 100.0 0.0 0.0)
(cons 50 (/ pi 2.0)) '(41 . 2.0))
0 0)
'(1.0 0.0 0.0)))
;; MINSERT-Spalte 2 bei Spaltenabstand 3000, gedreht um 90 Grad -> entlang +Y
(tu-eqf "lg-insert-tf/minsert" '(0.0 6000.0 0.0)
(car (lg-insert-tf (list '(2 . "TU_KEIN_BLOCK") '(10 0.0 0.0 0.0) (cons 50 (/ pi 2.0))
'(70 . 3) '(44 . 3000.0))
2 0)))
;; verschachtelt: Container bei (1000,0) um 90 Grad, Kind bei lokal (0,2000)
(tu-eqf "lg-tf-verketten" '(-1000.0 0.0 0.0)
(car (lg-tf-verketten
(lg-insert-tf (list '(2 . "TU_KEIN_BLOCK") '(10 1000.0 0.0 0.0) (cons 50 (/ pi 2.0))) 0 0)
(lg-insert-tf (list '(2 . "TU_KEIN_BLOCK") '(10 0.0 2000.0 0.0)) 0 0))))
(tu-nil "lg-gang-aus-ecken/entartet"
(lg-gang-aus-ecken '((0.0 0.0) (4000.0 0.0) (4000.0 0.0) (0.0 0.0))))
;; --- JSON-Schreiber ---
(tu-eq "lg-json-wert/nil" "null" (lg-json-wert nil))
(tu-eq "lg-json-wert/t" "true" (lg-json-wert T))
(tu-eq "lg-json-wert/int" "3" (lg-json-wert 3))
(tu-eq "lg-json-wert/real" "2.5" (lg-json-wert 2.5))
(tu-eq "lg-json-wert/rund" "1000" (lg-json-wert 1000.0))
(tu-eq "lg-json-wert/str" "\"a\\\"b\"" (lg-json-wert "a\"b"))
(tu-eq "lg-json-wert/roh" "[1]" (lg-json-wert (list 'ROH "[1]")))
(tu-eq "lg-json-obj" "{\"a\": 1, \"b\": \"x\"}" (lg-json-obj '(("a" . 1) ("b" . "x"))))
(tu-eq "lg-json-ebenen" "[{\"schienenhoehe_mm\": 2300, \"warenlaenge_mm\": 1200}]"
(cadr (lg-json-ebenen "2300/1200")))
;; --- Regelprofil-Aufloesung ---
(tu-eq "lg-bedingung/leer" 'ja (lg-bedingung-pruefen nil nil))
(tu-eq "lg-bedingung/gleich" 'ja (lg-bedingung-pruefen "brandgefaehrdung = normal"
'(("brandgefaehrdung" . "normal"))))
(tu-eq "lg-bedingung/ungleich" 'nein (lg-bedingung-pruefen "brandgefaehrdung = normal"
'(("brandgefaehrdung" . "erhoeht_ohne_loeschanlage"))))
(tu-eq "lg-bedingung/fehlt" 'unbekannt (lg-bedingung-pruefen "brandgefaehrdung = normal" nil))
(tu-eq "lg-bedingung/groesser" 'ja (lg-bedingung-pruefen "absturzhoehe > 12000" '(("absturzhoehe" . 13000))))
(tu-eq "lg-bedingung/kleinergl" 'nein (lg-bedingung-pruefen "absturzhoehe <= 12000" '(("absturzhoehe" . "13000"))))
;; min: strengster = groesster, max: strengster = kleinster
(setq _regel (ssg-json-parse
"{\"id\": \"s\", \"art\": \"min\", \"werte\": [{\"wert\": 590, \"quelle\": \"A\"}, {\"wert\": 600, \"quelle\": \"B\"}]}"))
(tu-eq "lg-regel/min-strengster" 600 (car (lg-regel-aufloesen _regel nil)))
(tu-eq "lg-regel/min-gewinner" "B" (ssg-json-get (cadr (lg-regel-aufloesen _regel nil)) "quelle"))
(setq _regel (ssg-json-parse
"{\"id\": \"s\", \"art\": \"max\", \"werte\": [{\"wert\": 650, \"quelle\": \"A\"}, {\"wert\": 660, \"quelle\": \"B\"}]}"))
(tu-eq "lg-regel/max-strengster" 650 (car (lg-regel-aufloesen _regel nil)))
(setq _regel (ssg-json-parse (strcat
"{\"id\": \"f\", \"art\": \"max\", \"werte\": ["
"{\"wert\": 35000, \"bedingung\": \"brandgefaehrdung = normal\"},"
"{\"wert\": 25000, \"bedingung\": \"brandgefaehrdung = erhoeht_ohne_loeschanlage\"}]}")))
(tu-eq "lg-regel/bedingung-normal" 35000
(car (lg-regel-aufloesen _regel '(("brandgefaehrdung" . "normal")))))
(tu-eq "lg-regel/bedingung-erhoeht" 25000
(car (lg-regel-aufloesen _regel '(("brandgefaehrdung" . "erhoeht_ohne_loeschanlage")))))
(tu-eq "lg-regel/bedingung-fehlt-konservativ" 25000 (car (lg-regel-aufloesen _regel nil)))
(tu-nil "lg-regel/nichts-zutreffend"
(lg-regel-aufloesen (ssg-json-parse
"{\"id\": \"x\", \"art\": \"max\", \"werte\": [{\"wert\": 1, \"bedingung\": \"a = b\"}]}")
'(("a" . "c"))))
(setq _regel (ssg-json-parse (strcat
"{\"id\": \"b\", \"art\": \"min\", \"werte\": [{\"tabelle\": [[5, 875], [20, 1000], [200, 1200]],"
" \"tabellen_schluessel\": \"personen\"}]}")))
(tu-eq "lg-regel/tabelle-15" 1000 (car (lg-regel-aufloesen _regel '(("personen" . 15)))))
(tu-eq "lg-regel/tabelle-5" 875 (car (lg-regel-aufloesen _regel '(("personen" . 5)))))
(tu-eq "lg-regel/tabelle-ueber" 1200 (car (lg-regel-aufloesen _regel '(("personen" . 500)))))
(tu-eq "lg-regel/tabelle-fehlt" 1200 (car (lg-regel-aufloesen _regel nil)))
;; Vererbung: Kind ersetzt Regel b, ergaenzt c, Kopf vom Kind
(setq _prof (lg-profil-mischen
(ssg-json-parse "{\"land\": \"DE\", \"regeln\": [{\"id\": \"a\", \"x\": 1}, {\"id\": \"b\", \"x\": 1}]}")
(ssg-json-parse "{\"land\": \"SK\", \"regeln\": [{\"id\": \"b\", \"x\": 2}, {\"id\": \"c\", \"x\": 3}]}")))
(tu-eq "lg-profil-mischen/ids" '("a" "b" "c")
(mapcar '(lambda (r) (ssg-json-get r "id")) (ssg-json-get _prof "regeln")))
(tu-eq "lg-profil-mischen/ersetzt" 2 (ssg-json-get (lg-regel-finden _prof "b") "x"))
(tu-eq "lg-profil-mischen/kopf" "SK" (ssg-json-get _prof "land"))
;; echte Profile (wie tu-tests-json gegen die Geruest-Daten): SK erbt DE
(if (and (lg-regelwerk-pfad "SK") (findfile (lg-regelwerk-pfad "SK")))
(progn
(setq _prof (lg-profil-laden-roh "SK" nil))
(tu-eq "lg-profil/sk-erbt-de" 190
(car (lg-regel-aufloesen (lg-regel-finden _prof "treppe.steigung_max") nil)))
(tu-eq "lg-profil/laufhoehe" 3000
(car (lg-regel-aufloesen (lg-regel-finden _prof "treppe.laufhoehe_max") nil)))
(tu-eq "lg-profil/schrittmass-schnittmenge" 600
(car (lg-regel-aufloesen (lg-regel-finden _prof "treppe.schrittmass_min") nil)))
(tu-eq "lg-profil/gelaender-14122" 1100
(car (lg-regel-aufloesen (lg-regel-finden _prof "gelaender.hoehe_min")
'(("absturzhoehe" . 3100)))))
(tu-nil "lg-profil/sk-ungepflegt" (ssg-json-get _prof "gepflegt")))
(tu-record nil "lg-profil/dateien" "cfg/regelwerk/SK.json nicht gefunden (DXFM_CFG?)"))
)
)
)
(defun c:TEST_UNIT ( / out-dir report)
(tu-reset)
(princ "\n================================================================")
@@ -3078,7 +3513,7 @@
"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-tests-hoehen-fam")
"tu-tests-werkzeuge" "tu-tests-poly" "tu-tests-lager" "tu-tests-kf" "tu-tests-hoehen-fam")
(tu-run-block fn))
(princ "\n\n----------------------------------------------------------------")