[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

Lisp/LagerInsert.lsp

@@ -1185,11 +1185,30 @@
       )
     )
   )
+  ;; Randgaenge selbst an den AEUSSEREN Sperrflaechen (manuelle/geaenderte
+  ;; Objekte) beschneiden - ein von Hand gesetzter Gang ersetzt den Randgang
+  ;; dort, wo er liegt, statt von ihm ueberlagert zu werden.
   (foreach s rand-str
-    (setq recs (cons (list "randgang" (cadr s) (caddr s) (cadddr s)) recs)))
+    (foreach st (lg-randgang-stuecke (cadr s) (caddr s) (cadddr s) (lg-param params "sperr" nil) min-g)
+      (setq recs (cons (list "randgang" (car st) (cadr st) (cadddr s)) recs))))
   (list (reverse recs) (- (- ymax oben) y) module)
 )
 
+;; Stuecke eines Randgangs (Mittellinie p1-p2, Breite b) ohne die Flaechen
+;; der Sperrpolygone (gleiches System). Reiner Kern ueber lg-linie-zuschnitt.
+;; Rueckgabe ((q1 q2) ...); ohne Ueberdeckung ((p1 p2)).
+(defun lg-randgang-stuecke (p1 p2 b sperr min-g / a l lok st)
+  (setq a (angle p1 p2) l (distance p1 p2))
+  (setq lok (mapcar '(lambda (poly)
+                       (ssg-poly-drehen (mapcar '(lambda (q) (list (- (car q) (car p1)) (- (cadr q) (cadr p1)))) poly)
+                                        (- a) '(0.0 0.0)))
+                    sperr))
+  (setq st (if lok (lg-linie-zuschnitt l b lok min-g) 'unveraendert))
+  (if (eq st 'unveraendert)
+    (list (list p1 p2))
+    (mapcar '(lambda (i) (list (polar p1 a (car i)) (polar p1 a (cadr i)))) st))
+)
+
 ;; Richtung der Reihen als Vorgabe: Winkel der laengsten Konturkante (Grad,
 ;; auf [0,180) normiert).
 (defun lg-kontur-richtung (pts / best w l)
@@ -1381,6 +1400,15 @@
                     (append (lg-alle-bloecke "LG_REIHE_*") (lg-alle-bloecke "LG_GANG_*")))
 )
 
+;; Alle von Hand gesetzten oder geaenderten Reihen/Gaenge (QUELLE manuell
+;; oder auto_geaendert) des Geschosses gs (String) - gleich welchem Bereich
+;; sie gehoeren und wo ihre Mitte liegt. Sie sind Sperre fuer jede Fuellung.
+(defun lg-von-hand-auf-geschoss (gs)
+  (vl-remove-if-not
+    '(lambda (e) (and (= (cdr (assoc "GESCHOSS" (ssg-attrib-read e))) gs) (lg-von-hand-p e)))
+    (append (lg-alle-bloecke "LG_REIHE_*") (lg-alle-bloecke "LG_GANG_*")))
+)
+
 ;; Von Hand gesetzte Reihen/Gaenge (QUELLE manuell) desselben Geschosses,
 ;; die nicht mit einem Bereich verknuepft sind, aber mit ihrer Mitte in der
 ;; Kontur pts liegen (z.B. Altbestand von LG_REIHE vor der Verknuepfung).
@@ -1402,8 +1430,8 @@
 ;; Die automatisch erzeugten Kinder (QUELLE auto) werden vorher entfernt
 ;; (Sektions-Neuaufbau statt Feld-Splice). Von Hand gesetzte (manuell) und
 ;; von Hand geaenderte (auto_geaendert) Reihen und Gaenge bleiben stehen und
-;; sparen ihre Flaeche aus - ebenso unverknuepfte manuelle Objekte in der
-;; Kontur. Rueckgabe: (reihen gaenge restbreite).
+;; sparen ihre Flaeche aus - das gilt fuer alle von-Hand-Objekte des
+;; Geschosses, auch aus den Randgaengen. Rueckgabe: (reihen gaenge restbreite).
 (defun lg-bereich-fuellen (bereich-ent / a kontur pts w pts-l erg z gs
                               n-reihen n-gaenge werte-reihe werte-gang p1 p2 behalten)
   (setq a (ssg-attrib-read bereich-ent)
@@ -1433,8 +1461,10 @@
                         (cons "min_gang"  (lg-zahl (lg-vorgabe '("bereich" "min_ganglaenge_mm") 100)))
                         (cons "rand"      (lg-bereich-rand a))
                         (cons "richtung"  w)
+                        ;; Sperre: ALLE von Hand gesetzten/geaenderten Objekte des
+                        ;; Geschosses (auch fremder Bereiche, auch nur teilweise in der Kontur)
                         (cons "sperr"     (mapcar '(lambda (g) (ssg-poly-drehen (lg-linie-polygon g) (- w) '(0.0 0.0)))
-                                                  behalten)))))
+                                                  (lg-von-hand-auf-geschoss (cdr (assoc "GESCHOSS" a))))))))
       (setq gs (cdr (assoc "GESCHOSS" a)) n-reihen 0 n-gaenge 0)
       (setq werte-reihe
         (list (cons "GESCHOSS" gs) (cons "TIEFE_mm" (cdr (assoc "REGALTIEFE_mm" a)))
@@ -1573,11 +1603,13 @@
 ;; (dx dy) versetzt; in einer 3D-Zeichnung (Konturen auf Belagshoehe)
 ;; zusaetzlich in Z um den Hoehenabstand.
 
-;; Reiner Kern: Belag eines kopierten Bereichs/Gangs. Entsprach er dem
-;; Geschossbelag der Quelle, folgt er dem neuen Geschossbelag; bewusst
-;; abweichende (z.B. Gitterrost-Gang auf Spanplatte-Buehne) bleiben.
+;; Reiner Kern: Belag eines kopierten Bereichs/Gangs. Ist fuer die Kopie
+;; ein Belag gewaehlt, bekommen ALLE Gaenge und Bereiche ihn - auch von Hand
+;; gesetzte Rand-/Sondergaenge (sonst blieb der alte Belag stehen). Ohne
+;; Wahl (neu leer) bleibt der Belag. alt (Belag der Quelle) wird nicht mehr
+;; ausgewertet, bleibt aber fuer die Aufrufer in der Signatur.
 (defun lg-kopie-belag (belag alt neu)
-  (if (and belag alt neu (= (strcase belag) (strcase alt))) neu belag)
+  (if (and belag neu (= (type neu) 'STR) (/= neu "")) neu belag)
 )
 
 ;; Reiner Kern: Attributwerte einer kopierten Reihe/eines Gangs fuer
@@ -2186,6 +2218,67 @@
   (princ)
 )
 
+;; ------------------------------------------------------------
+;; Bereich bearbeiten: was eingezeichnet ist, wird aktualisiert, nicht
+;; ueberschrieben. Nur eine Geometrieaenderung fuehrt (auf Rueckfrage) zur
+;; Neuberechnung der automatisch erzeugten Kinder.
+;; ------------------------------------------------------------
+
+;; Bereichs-Attribute, deren Aenderung die Lage der Reihen/Gaenge aendert.
+(setq *lg-bereich-geometrie-tags*
+  '("GANGBREITE_mm" "REGALTIEFE_mm" "REIHEN_JE_GANG" "QUERGANG_ABSTAND_mm" "QUERGANG_BREITE_mm"
+    "RICHTUNG" "RANDGANG_N_mm" "RANDGANG_O_mm" "RANDGANG_S_mm" "RANDGANG_W_mm"))
+
+;; Reiner Kern: T, wenn sich zwischen alt und neu (Attribut-Alists) ein
+;; Geometrie-Wert aendert (numerisch verglichen, leer = 0; fehlt ein Tag in
+;; neu, gilt er als unveraendert).
+(defun lg-bereich-geometrie-geaendert-p (alt neu)
+  (if (vl-some '(lambda (tag / x y)
+                  (if (lg-wert-fuer-tag tag neu)
+                    (progn
+                      (setq x (cond ((lg-zahl (lg-wert-fuer-tag tag alt))) (0.0))
+                            y (cond ((lg-zahl (lg-wert-fuer-tag tag neu))) (0.0)))
+                      (not (equal x y 1e-6)))))
+               *lg-bereich-geometrie-tags*)
+    T)
+)
+
+;; Geaenderte Nicht-Geometrie-Werte auf ALLE vorhandenen Kinder des Bereichs
+;; uebertragen (QUELLE egal, nichts wird geloescht oder neu gelegt):
+;; BELAG -> jeder Gang wird mit dem neuen Belag an derselben Stelle neu
+;; aufgebaut (Belag steckt im Blocknamen/der Schraffur), HAENGEEBENEN ->
+;; Attribut jeder Reihe. Rueckgabe: Anzahl geaenderter Objekte.
+(defun lg-bereich-attribute-uebertragen (ent alt neu / b-alt b-neu e-alt e-neu n ka)
+  (setq b-alt (lg-wert-fuer-tag "BELAG" alt) b-neu (lg-wert-fuer-tag "BELAG" neu)
+        e-alt (lg-wert-fuer-tag "HAENGEEBENEN" alt) e-neu (lg-wert-fuer-tag "HAENGEEBENEN" neu)
+        n 0)
+  (foreach k (lg-bereich-kinder ent)
+    (setq ka (ssg-attrib-read k))
+    (cond
+      ((wcmatch (strcase (lg-blockname k)) "LG_GANG_*")
+        (if (and b-neu (/= b-neu "") (not (equal b-alt b-neu))
+                 (not (equal (lg-wert-fuer-tag "BELAG" ka) b-neu)))
+          (if (lg-linie-neu-aufbauen k (lg-wert-setzen ka "BELAG" b-neu)) (setq n (1+ n)))))
+      ((wcmatch (strcase (lg-blockname k)) "LG_REIHE_*")
+        (if (and e-neu (not (equal e-alt e-neu)))
+          (progn (lg-attribute-setzen k (list (cons "HAENGEEBENEN" e-neu))) (setq n (1+ n)))))
+    )
+  )
+  n
+)
+
+;; Nach dem Bereichsdialog: Werte uebertragen, bei Geometrieaenderung
+;; Rueckfrage "neu berechnen?" (Vorgabe Ja; ohne Aenderung Vorgabe Nein -
+;; damit laesst sich ein Bereich auch bewusst neu berechnen).
+(defun lg-bereich-aktualisieren (ent alt neu / geo n)
+  (setq n (lg-bereich-attribute-uebertragen ent alt neu)
+        geo (lg-bereich-geometrie-geaendert-p alt neu))
+  (if (> n 0) (princ (ssg-textf "lg-bereich-uebertragen" (list (itoa n)))))
+  (if (ssg-in-yesno (ssg-text "lg-frage-neu-berechnen") geo)
+    (lg-bereich-fuellen ent)
+    (lg-darstellung-geschoss (atoi (cond ((cdr (assoc "GESCHOSS" (ssg-attrib-read ent)))) ("0")))))
+)
+
 ;; Doppelklick-Ziel (SSG_BLOCKEDIT, Zweig LG_*) und Befehl LG_EDIT.
 (defun lg-edit-ent (ent / name a neu)
   (setq name (strcase (lg-blockname ent))
@@ -2205,7 +2298,7 @@
           ;; Pfeil des Symbols folgt der Reihenrichtung
           (vla-put-Rotation (vlax-ename->vla-object ent)
                             (* (/ (cond ((lg-zahl (cdr (assoc "RICHTUNG" neu)))) (0.0)) 180.0) pi))
-          (lg-bereich-fuellen ent))))
+          (lg-bereich-aktualisieren ent a neu))))
     ((wcmatch name "LG_REIHE_*")
       (if (setq neu (lg-dialog "lg_reihe" *lg-felder-reihe* a nil))
         (progn