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

[FIX] Lager: manuelle Gaenge/Randgaenge nicht mehr ueberschreiben, Bereich-Edit uebertraegt statt neu zu berechnen

tests/test_lager.lsp

@@ -100,7 +100,7 @@
   (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 sl
-                       kb2 b2 kinder mg mg2 hg alt eb
+                       kb2 b2 kinder mg mg2 hg alt eb mr ba
                        r1 gg1 n-alt g2 r2 gg2 ids b2k n-kinder bb rg rk zl
                        b3 rh3 mg3 ge3 ag3 n3 mr3 alt3)
   (setvar "CMDECHO" 0)
@@ -244,6 +244,39 @@
   (setq mg2 (lg-linie-neu-aufbauen mg (lg-wert-setzen (ssg-attrib-read mg) "BELAG" "spanplatte")))
   (tlg-eq "manuell: belag geaendert" "LG_GANG_4000_1000_SPANPLATTE" (if mg2 (cdr (assoc 2 (entget mg2)))))
   (tlg-eq "manuell: bleibt kind" T (if (member mg2 (lg-bereich-kinder b2)) T nil))
+  ;; Manueller Gang IM Nord-Randgang: Neuberechnung legt keinen Randgang darueber
+  (setq mr (lg-gang-einfuegen '(21000.0 5500.0 0.0) '(23000.0 5500.0 0.0)
+             (list (cons "GESCHOSS" "1") (cons "BREITE_mm" "1000") (cons "ART" "randgang")
+                   (cons "BELAG" "gitterrost"))))
+  (lg-bereich-fuellen b2)
+  (tlg-eq "randgang: manueller bleibt" T (if (entget mr) T nil))
+  (tlg-eq "randgang: kein ueberlappender auto-randgang" nil
+          (vl-some '(lambda (k / bb)
+                      (setq bb (ssg-poly-bbox (lg-linie-polygon k)))
+                      (if (and (= (tlg-attr k "QUELLE") "auto")
+                               (> (- (min (car (cadr bb)) 23000.0) (max (car (car bb)) 21000.0)) 1.0)
+                               (> (- (min (cadr (cadr bb)) 6000.0) (max (cadr (car bb)) 5000.0)) 1.0))
+                        k))
+                   (tlg-nur (lg-bereich-kinder b2) "LG_GANG_*")))
+  (tlg-eq "randgang: nord ausgespart (2 stuecke + sued)" 3
+          (tlg-anzahl-art (vl-remove-if-not '(lambda (k) (= (tlg-attr k "QUELLE") "auto")) (lg-bereich-kinder b2))
+                          "randgang"))
+  ;; Belag des Bereichs aendern: vorhandene Gaenge werden umgestellt, nichts neu gelegt
+  (setq ba (ssg-attrib-read b2) n-kinder (length (lg-bereich-kinder b2)))
+  (tlg-eq "uebertragen: geaendert" T
+          (> (lg-bereich-attribute-uebertragen b2 ba (lg-wert-setzen ba "BELAG" "gitterrost")) 0))
+  (setq kinder (lg-bereich-kinder b2))
+  (tlg-eq "uebertragen: anzahl gleich" n-kinder (length kinder))
+  (tlg-eq "uebertragen: alle gitterrost" (length (tlg-nur kinder "LG_GANG_*"))
+          (tlg-anzahl-attr (tlg-nur kinder "LG_GANG_*") "BELAG" "gitterrost"))
+  (tlg-eq "uebertragen: manuell bleibt manuell" 2 (tlg-anzahl-attr kinder "QUELLE" "manuell"))
+  ;; Zustand fuer die folgenden Tests wiederherstellen
+  (lg-bereich-attribute-uebertragen b2 (lg-wert-setzen ba "BELAG" "gitterrost") ba)
+  (tlg-eq "uebertragen: zurueck auf spanplatte" 0
+          (tlg-anzahl-attr (tlg-nur (lg-bereich-kinder b2) "LG_GANG_*") "BELAG" "gitterrost"))
+  (entdel (vl-some '(lambda (k) (if (wcmatch (cdr (assoc 2 (entget k))) "LG_GANG_2000_1000_*") k))
+                   (lg-bereich-kinder b2)))
+  (lg-bereich-fuellen b2)
   ;; Hallenboden: keine Schraffur; ausserhalb jedes Bereichs: nicht verknuepft
   (setq hg (lg-gang-einfuegen '(40000.0 0.0 0.0) '(42000.0 0.0 0.0)
              (list (cons "GESCHOSS" "1") (cons "BREITE_mm" "1500") (cons "ART" "gang")
@@ -362,12 +395,14 @@
                        (setq nr (tlg-attr b "NR"))
                        (vl-every '(lambda (k) (= (tlg-attr k "BEREICH") nr)) (lg-bereich-kinder b)))
                     (tlg-gs "LG_BEREICH" 2)))
-  ;; Belag folgt dem Geschoss (Spanplatte -> Gitterrost), Hallenboden-Gang bleibt
+  ;; ALLE Gaenge bekommen den gewaehlten Belag (Gitterrost) - auch manuelle
+  ;; und der Hallenboden-Gang
   (tlg-eq "kopie: belag folgt" 0 (tlg-anzahl-attr gg2 "BELAG" "spanplatte"))
+  (tlg-eq "kopie: alle gaenge neuer belag" (length gg2) (tlg-anzahl-attr gg2 "BELAG" "gitterrost"))
   (tlg-eq "kopie: manueller gang gitterrost" 1
           (length (tlg-nur (vl-remove-if-not '(lambda (e) (= (tlg-attr e "QUELLE") "manuell")) gg2)
                            "LG_GANG_4000_1000_GITTERROST")))
-  (tlg-eq "kopie: hallenboden bleibt" 1 (length (tlg-nur gg2 "LG_GANG_2000_1500_HALLENBODEN")))
+  (tlg-eq "kopie: hallenboden-gang folgt" 1 (length (tlg-nur gg2 "LG_GANG_2000_1500_GITTERROST")))
   (tlg-eq "kopie: bereich belag" T
           (vl-every '(lambda (b) (= (tlg-attr b "BELAG") "gitterrost")) (tlg-gs "LG_BEREICH" 2)))
   (tlg-eq "kopie: unter_reihe gitterkorb" 1 (tlg-anzahl-attr (tlg-gs "LG_BEREICH" 2) "UNTER_REIHE" "gitterkorb"))

tests/test_unit.lsp

@@ -3312,9 +3312,38 @@
 
       ;; --- Geschoss kopieren ---
       (setq _kand2 (list (list 1 0.0 _sq0) (list 2 3100.0 _sq0)))
+      ;; Kopie: ALLE Gaenge bekommen den gewaehlten Belag, auch abweichende
       (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-eq  "lg-kopie-belag/eigen"   "spanplatte" (lg-kopie-belag "gitterrost" "hallenboden" "spanplatte"))
+      (tu-eq  "lg-kopie-belag/ohne-wahl" "gitterrost" (lg-kopie-belag "gitterrost" "hallenboden" ""))
       (tu-nil "lg-kopie-belag/nil"                  (lg-kopie-belag nil "hallenboden" "spanplatte"))
+      ;; Randgang an Sperrflaechen (manueller Gang) beschnitten
+      (tu-eqf "lg-randgang-stuecke/geteilt"
+              '(((0.0 5800.0) (4000.0 5800.0)) ((5000.0 5800.0) (10000.0 5800.0)))
+              (lg-randgang-stuecke '(0.0 5800.0) '(10000.0 5800.0) 400.0
+                                   '(((4000.0 5500.0) (5000.0 5500.0) (5000.0 6000.0) (4000.0 6000.0))) 100.0))
+      (tu-eqf "lg-randgang-stuecke/frei" '(((0.0 5800.0) (10000.0 5800.0)))
+              (lg-randgang-stuecke '(0.0 5800.0) '(10000.0 5800.0) 400.0 nil 100.0))
+      (tu-nil "lg-randgang-stuecke/ganz-ueberdeckt"
+              (lg-randgang-stuecke '(0.0 5800.0) '(10000.0 5800.0) 400.0
+                                   '(((-10.0 5500.0) (10010.0 5500.0) (10010.0 6000.0) (-10.0 6000.0))) 100.0))
+      (setq _fr (lg-fuellung-berechnen '((0.0 0.0) (10000.0 0.0) (10000.0 6000.0) (0.0 6000.0))
+                  (list (cons "rand" '(("N" . 1000.0) ("O" . 0.0) ("S" . 0.0) ("W" . 0.0)))
+                        (cons "sperr" '(((4000.0 5000.0) (5000.0 5000.0) (5000.0 6000.0) (4000.0 6000.0)))))))
+      (tu-eq "lg-fuellung/randgang-ausgespart" 2
+             (length (vl-remove-if-not '(lambda (r) (= (car r) "randgang")) (car _fr))))
+      ;; Bereich bearbeiten: nur Geometrie fuehrt zur Neuberechnung
+      (setq _ba '(("GANGBREITE_mm" . "1000") ("REGALTIEFE_mm" . "700") ("BELAG" . "spanplatte")
+                  ("HAENGEEBENEN" . "2300/1200") ("RANDGANG_N_mm" . "0")))
+      (tu-nil "lg-bereich-geometrie/belag"
+              (lg-bereich-geometrie-geaendert-p _ba (lg-wert-setzen (lg-wert-setzen _ba "BELAG" "gitterrost")
+                                                                    "HAENGEEBENEN" "2400/1000")))
+      (tu-nil "lg-bereich-geometrie/gleich-zahl"
+              (lg-bereich-geometrie-geaendert-p _ba (lg-wert-setzen _ba "GANGBREITE_mm" "1000.0")))
+      (tu-eq "lg-bereich-geometrie/gangbreite" T
+             (lg-bereich-geometrie-geaendert-p _ba (lg-wert-setzen _ba "GANGBREITE_mm" "1200")))
+      (tu-eq "lg-bereich-geometrie/randgang" T
+             (lg-bereich-geometrie-geaendert-p _ba (lg-wert-setzen _ba "RANDGANG_N_mm" "1600")))
       (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"))