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

tests/test_lager.lsp

@@ -79,11 +79,27 @@
   (mapcar '(lambda (ed) (cons (cdr (assoc 2 ed)) T))
           (vl-remove-if-not '(lambda (ed) (= (cdr (assoc 0 ed)) "ATTDEF")) (lg-blockdef-objekte bname))))
 
+;; Objekte eines Typs (Wildcard) auf einem Layer.
+(defun tlg-auf-layer (typ layer / ss i erg)
+  (setq erg nil)
+  (if (setq ss (ssget "_X" (list (cons 0 typ) (cons 8 layer))))
+    (progn (setq i 0)
+           (repeat (sslength ss) (setq erg (cons (ssname ss i) erg) i (1+ i)))))
+  erg)
+
+;; Laenge einer offenen Polylinie (Punktliste).
+(defun tlg-linienlaenge (pts / s)
+  (setq s 0.0)
+  (while (cdr pts)
+    (setq s (+ s (distance (list (car (car pts)) (cadr (car pts))) (list (car (cadr pts)) (cadr (cadr pts)))))
+          pts (cdr pts)))
+  s)
+
 ;; Geschoss-Objekt Nr. nr aus den geparsten Export-Daten.
 (defun tlg-export-geschoss (daten nr)
   (vl-some '(lambda (g) (if (= (ssg-json-get g "nr") nr) g)) (ssg-json-get daten "geschosse")))
 
-(defun lager:tests ( / k0 k1 g0 g1 kb bereich reihen gaenge r0 neu raw daten pfad f eg0 eg1 kr
+(defun lager:tests ( / k0 k1 g0 g1 kb bereich reihen gaenge r0 neu raw daten pfad f eg0 eg1 kr sl
                        kb2 b2 kinder mg mg2 hg alt eb
                        r1 gg1 n-alt g2 r2 gg2 ids b2k n-kinder bb rg rk zl
                        b3 rh3 mg3 ge3 ag3 n3 mr3 alt3)
@@ -281,6 +297,26 @@
                                  (ssg-json-get daten "bereiche"))
                         "unter_reihe"))
 
+  ;; --- Darstellung der Sicherung (G1): Schraffur je Reihe, Rand nur an offenen Kanten ---
+  (lg-darstellung-geschoss 1)
+  (setq sl (lg-layer-name (car (lg-layer-basis "sicherung")) 1))
+  (tlg-eq "darstellung: korb-schraffuren" (length kr)
+          (length (vl-remove-if-not '(lambda (e) (= (cdr (assoc 2 (entget e))) "ANSI38"))
+                                    (tlg-auf-layer "HATCH" sl))))
+  (tlg-eq "darstellung: alle reihen schraffiert" (length (tlg-gs "LG_REIHE_*" 1))
+          (length (tlg-auf-layer "HATCH" sl)))
+  (tlg-eq "darstellung: randlaenge = offene kanten"
+          (apply '+ (mapcar '(lambda (r) (+ (ssg-json-get (ssg-json-get r "gitterkorb") "offen_laengs_mm")
+                                            (ssg-json-get (ssg-json-get r "gitterkorb") "offen_stirn_mm")))
+                            kr))
+          (apply '+ (mapcar '(lambda (e) (tlg-linienlaenge (ssg-lwpoly-punkte e)))
+                            (tlg-auf-layer "LWPOLYLINE" sl))))
+  (setq n3 (length (tlg-auf-layer "*" sl)))
+  (lg-darstellung-geschoss 1)
+  (tlg-eq "darstellung: kein doppeltes zeichnen" n3 (length (tlg-auf-layer "*" sl)))
+  (tlg-eq "darstellung: hallenboden ohne" 0
+          (lg-darstellung-geschoss 0))
+
   (setq pfad (strcat (getenv "DXFMAKRO") "/tests/output/lager_tests_lager.json"))
   (if (setq f (open pfad "w")) (progn (princ raw f) (close f)))
 

tests/test_unit.lsp

@@ -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)