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