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

[ADD] Lager: Darstellung Gitterrost/Gitterkorb unter Regalreihen, Farben aus lager.json, LG_DARSTELLUNG

Browse Source
This commit is contained in:
Simon Hensch committed 2026-11-04 08:35:37 +01:00
1 parent 57b01ad516
commit a887ae8152
12 files changed
+410 -42
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

tests/test_unit.lsp
+37
View File
@@ -3537,6 +3537,43 @@
(tu-eqf "lg-offene-kanten/abstand" '((8000.0 1400.0) (8000.0 1400.0))
(lg-reihen-offene-kanten
(list _e1 '((0.0 360.0) (4000.0 360.0) (4000.0 1060.0) (0.0 1060.0))) 1.0))
;; offene Abschnitte einer Kante
(tu-eqf "lg-kante-offen-intervalle/frei" '((0.0 4000.0))
(lg-kante-offen-intervalle '((4000.0 350.0) (0.0 350.0)) nil 1.0))
(tu-nil "lg-kante-offen-intervalle/ganz-zu"
(lg-kante-offen-intervalle '((4000.0 350.0) (0.0 350.0)) (list _e2) 1.0))
;; _e3 liegt auf x 2000..6000 an; Kante laeuft von x 4000 nach 0
(tu-eqf "lg-kante-offen-intervalle/halb" '((2000.0 4000.0))
(lg-kante-offen-intervalle '((4000.0 1050.0) (0.0 1050.0)) (list _e3) 1.0))
;; Darstellung der Sicherung: Ruecken an Ruecken -> keine Abgrenzung dazwischen
(setq _sg (lg-sicherung-geometrie (list (list _e1 "gitterkorb") (list _e2 "gitterkorb")) 1.0))
(tu-eq "lg-sicherung/flaechen" 2 (length (vl-remove-if-not '(lambda (x) (= (car x) "flaeche")) _sg)))
(tu-eq "lg-sicherung/raender" 6 (length (vl-remove-if-not '(lambda (x) (= (car x) "rand")) _sg)))
(tu-eqf "lg-sicherung/randlaenge = offene kanten"
(apply '+ (mapcar '(lambda (o) (+ (car o) (cadr o))) (lg-reihen-offene-kanten (list _e1 _e2) 1.0)))
(apply '+ (mapcar '(lambda (x) (distance (cadr x) (caddr x)))
(vl-remove-if-not '(lambda (x) (= (car x) "rand")) _sg))))
(tu-eq "lg-sicherung/keine-abgrenzung-auf-beruehrlinie" T
(not (vl-some '(lambda (x) (and (= (car x) "rand")
(equal (cadr (cadr x)) 350.0 1e-6)
(equal (cadr (caddr x)) 350.0 1e-6)))
_sg)))
;; Gitterrost ohne Rand, "keine" ohne alles - schliesst aber die Kante des Korbs
(tu-eq "lg-sicherung/gitterrost-keine"
'(("flaeche" . "gitterrost"))
(mapcar '(lambda (x) (cons (car x) (cadr x)))
(lg-sicherung-geometrie (list (list _e1 "gitterrost") (list _e2 "keine")) 1.0)))
(tu-eq "lg-sicherung/nachbar-ohne-sicherung" 3
(length (vl-remove-if-not '(lambda (x) (= (car x) "rand"))
(lg-sicherung-geometrie (list (list _e1 "gitterkorb") (list _e2 "keine")) 1.0))))
;; Farben und Gang-Belag
(tu-eq "lg-farbe-dxf/aci" '((62 . 3)) (lg-farbe-dxf 3))
(tu-eq "lg-farbe-dxf/rgb" '((420 . 16744448)) (lg-farbe-dxf "255,128,0"))
(tu-nil "lg-farbe-dxf/nil" (lg-farbe-dxf nil))
(tu-nil "lg-farbe-dxf/0" (lg-farbe-dxf 0))
(tu-nil "lg-farbe-dxf/kaputt" (lg-farbe-dxf "1,2"))
(tu-eq "lg-gang-belag-aus-name" "gitterrost" (lg-gang-belag-aus-name "LG_GANG_4000_1000_GITTERROST"))
(tu-nil "lg-gang-belag-aus-name/ohne" (lg-gang-belag-aus-name "LG_GANG_4000_1000"))
;; Gitterkorb vervollstaendigen: Boden, offene Kanten, Seitenflaeche
(setq _rk (lg-reihen-gitterkorb-berechnen
(list (list 'OBJ (cons "laenge_mm" 4000.0) (cons "tiefe_mm" 700.0)