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

[CHANGE] Lager-JSON: null nur fuer fehlende Werte, Regalrohr statt SCHIENEN, Plausibilitaetswarnungen

Browse Source
This commit is contained in:
Simon Hensch committed 2026-11-04 07:49:51 +01:00
1 parent d2729140ff
commit a20049a248
9 files changed
+433 -130
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

Lisp/LagerInsert.lsp
+276 -81
View File
@@ -384,7 +384,7 @@
(setq *lg-schema-reihe*
'(("ID" . "") ("GESCHOSS" . "") ("LAYER" . "") ("LAENGE" . "") ("TIEFE_mm" . "")
("HAENGEEBENEN" . "") ("SCHIENEN" . "") ("BEREICH" . "") ("QUELLE" . "")))
("HAENGEEBENEN" . "") ("BEREICH" . "") ("QUELLE" . "")))
(setq *lg-schema-gang*
'(("ID" . "") ("GESCHOSS" . "") ("LAYER" . "") ("LAENGE" . "") ("BREITE_mm" . "")
@@ -638,8 +638,7 @@
(setq *lg-felder-reihe*
'(("laenge" "LAENGE" "mm" nil)
("tiefe" "TIEFE_mm" "mm" nil)
("ebenen" "HAENGEEBENEN" "ebenen" nil)
("schienen" "SCHIENEN" "int0" nil)))
("ebenen" "HAENGEEBENEN" "ebenen" nil)))
;; LG_GESCHOSS_KOPIEREN - die Tags sind reine Dialogwerte, kein Block-Schema.
(setq *lg-felder-kopie*
@@ -1379,7 +1378,6 @@
(setq werte-reihe
(list (cons "GESCHOSS" gs) (cons "TIEFE_mm" (cdr (assoc "REGALTIEFE_mm" a)))
(cons "HAENGEEBENEN" (cdr (assoc "HAENGEEBENEN" a)))
(cons "SCHIENEN" (cdr (assoc "SCHIENEN_JE_GANG" a)))
(cons "BEREICH" (cdr (assoc "NR" a))) (cons "QUELLE" "auto")))
(foreach r (car erg)
(setq p1 (ssg-punkt-drehen (cadr r) w '(0.0 0.0))
@@ -1916,8 +1914,7 @@
(setq werte (lg-dialog "lg_reihe" *lg-felder-reihe*
(list (cons "LAENGE" "0")
(cons "TIEFE_mm" (lg-mm-str (lg-zahl (lg-vorgabe '("bereich" "regaltiefe_mm") 700))))
(cons "HAENGEEBENEN" (lg-vorgabe '("reihe" "haengeebenen") "2300/1200;1100/1100"))
(cons "SCHIENEN" (itoa (fix (lg-zahl (lg-vorgabe '("reihe" "schienen") 1))))))
(cons "HAENGEEBENEN" (lg-vorgabe '("reihe" "haengeebenen") "2300/1200;1100/1100")))
'("laenge")))
(if werte
(progn
@@ -2100,11 +2097,19 @@
(defun lg-json-obj (paare)
(strcat "{"
(ssg-join (mapcar '(lambda (p) (strcat (lg-json-str (car p)) ": " (lg-json-wert (cdr p)))) paare)
(ssg-join (mapcar '(lambda (p) (strcat (lg-json-str (car p)) ": " (lg-json-wert (cdr p))))
(lg-json-ohne-entfallend paare))
", ")
"}")
)
;; Regel fuer fehlende Werte: null = "fehlt, muesste eingegeben werden"
;; (offener Punkt fuer den Konsumenten); 'ENTFAELLT = "trifft hier nicht zu"
;; - solche Felder werden gar nicht geschrieben.
(defun lg-json-ohne-entfallend (paare)
(vl-remove-if '(lambda (p) (eq (cdr p) 'ENTFAELLT)) paare)
)
(defun lg-json-container-p (v)
(and v (listp v) (member (car v) '(OBJ ARR)))
)
@@ -2141,7 +2146,8 @@
(setq innen (strcat einr " ") obj-p (eq (car v) 'OBJ))
(setq zeilen
(if obj-p
(mapcar '(lambda (p) (strcat innen (lg-json-str (car p)) ": " (lg-json-text (cdr p) innen))) (cdr v))
(mapcar '(lambda (p) (strcat innen (lg-json-str (car p)) ": " (lg-json-text (cdr p) innen)))
(lg-json-ohne-entfallend (cdr v)))
(mapcar '(lambda (x) (strcat innen (lg-json-text x innen))) (cdr v))))
(if zeilen
(strcat (if obj-p "{" "[") "\n" (ssg-join zeilen ",\n") "\n" einr (if obj-p "}" "]"))
@@ -2150,7 +2156,12 @@
)
;; --- Zugriff auf OBJ-Records ---
(defun lg-j (obj key) (cdr (assoc key (cdr obj))))
;; Feld eines OBJ; nil, wenn es fehlt, ENTFAELLT ist oder obj kein OBJ ist.
(defun lg-j (obj key / v)
(if (and obj (listp obj) (eq (car obj) 'OBJ))
(progn (setq v (cdr (assoc key (cdr obj))))
(if (eq v 'ENTFAELLT) nil v)))
)
(defun lg-j-setzen (obj key wert / alt)
(if (setq alt (assoc key (cdr obj)))
@@ -2162,10 +2173,36 @@
(defun lg-j-bbox (bb) (if bb (cons 'ARR (append (car bb) (cadr bb)))))
(defun lg-n (v) (if (numberp v) (float v) 0.0))
;; Freiraum unter der Ware je Haengeebene (reiner Kern): Schienenhoehe -
;; Warenlaenge - naechsttiefere Schienenhoehe (unterste Ebene: - 0 = Belag).
;; ebenen = ((schienenhoehe warenlaenge) ...); Rueckgabe ((h w frei) ...),
;; nach Schienenhoehe absteigend. frei <= 0: Ware stoesst an.
(defun lg-ebenen-freiraum (ebenen / sort erg rest)
(setq sort (vl-sort ebenen '(lambda (a b) (> (car a) (car b)))) erg nil)
(while sort
(setq rest (cdr sort))
(setq erg (cons (list (car (car sort)) (cadr (car sort))
(- (car (car sort)) (cadr (car sort)) (if rest (car (car rest)) 0.0)))
erg)
sort rest))
(reverse erg)
)
(defun lg-j-ebenen (s)
(cons 'ARR
(mapcar '(lambda (e) (list 'OBJ (cons "schienenhoehe_mm" (car e)) (cons "warenlaenge_mm" (cadr e))))
(lg-haengeebenen-parse s)))
(mapcar '(lambda (e) (list 'OBJ (cons "schienenhoehe_mm" (car e)) (cons "warenlaenge_mm" (cadr e))
(cons "freiraum_unter_mm" (caddr e))))
(lg-ebenen-freiraum (lg-haengeebenen-parse s))))
)
;; Ausrichtung eines Gangs gegen die Reihenrichtung seines Bereichs (beide
;; in Grad): "laengs" (Abweichung < 45 Grad, Richtung egal) oder "quer";
;; nil ohne Reihenrichtung. Rein.
(defun lg-ausrichtung (winkel richtung / d)
(if (and (numberp winkel) (numberp richtung))
(progn
(setq d (rem (abs (- winkel richtung)) 180.0))
(if (< (min d (- 180.0 d)) 45.0) "laengs" "quer")))
)
;; Attributwert als Zahl bzw. Ganzzahl (nil, wenn leer).
@@ -2203,22 +2240,40 @@
(> (car (car a)) (car (car b))))))))
)
;; Gaenge je ART: (OBJ ("gang" . (OBJ anzahl laenge_mm flaeche_mm2)) ...),
;; gang/quergang/randgang immer vorhanden, weitere Arten dahinter.
(defun lg-gaenge-je-art (gaenge / erg art x l f)
(setq erg (mapcar '(lambda (a) (list a 0 0.0 0.0)) '("gang" "quergang" "randgang")))
;; Gaenge je ART: (OBJ ("gang" . (OBJ anzahl laenge_mm flaeche_mm2
;; anzahl_quer nach_breite)) ...), gang/quergang/randgang immer vorhanden,
;; weitere Arten dahinter. anzahl_quer = Gaenge mit ausrichtung "quer";
;; nach_breite = je Breite Anzahl/Laenge/Flaeche (Sonderflaechen erkennbar,
;; keine verfaelschte Durchschnittsbreite).
(defun lg-gaenge-je-art (gaenge / erg art x l b f br bx)
(setq erg (mapcar '(lambda (a) (list a 0 0.0 0.0 0 nil)) '("gang" "quergang" "randgang")))
(foreach g gaenge
(setq art (cond ((lg-j g "art")) ("unbekannt"))
x (assoc art erg)
(setq art (cond ((lg-j g "art")) ("unbekannt")))
(if (null (assoc art erg)) (setq erg (append erg (list (list art 0 0.0 0.0 0 nil)))))
(setq x (assoc art erg)
l (lg-n (lg-j g "laenge_mm"))
f (* l (lg-n (lg-j g "breite_mm"))))
(setq erg (if x
(subst (list art (1+ (cadr x)) (+ (caddr x) l) (+ (cadddr x) f)) x erg)
(append erg (list (list art 1 l f))))))
b (lg-n (lg-j g "breite_mm"))
f (* l b)
br (nth 5 x)
bx (assoc b br)
br (if bx
(subst (list b (1+ (cadr bx)) (+ (caddr bx) l) (+ (cadddr bx) f)) bx br)
(cons (list b 1 l f) br)))
(setq erg (subst (list art (1+ (nth 1 x)) (+ (nth 2 x) l) (+ (nth 3 x) f)
(+ (nth 4 x) (if (equal (lg-j g "ausrichtung") "quer") 1 0)) br)
x erg)))
(cons 'OBJ
(mapcar '(lambda (x) (cons (car x) (list 'OBJ (cons "anzahl" (cadr x))
(cons "laenge_mm" (caddr x))
(cons "flaeche_mm2" (cadddr x)))))
(mapcar '(lambda (x)
(cons (car x)
(list 'OBJ (cons "anzahl" (nth 1 x))
(cons "laenge_mm" (nth 2 x))
(cons "flaeche_mm2" (nth 3 x))
(cons "anzahl_quer" (nth 4 x))
(cons "nach_breite"
(cons 'ARR
(mapcar '(lambda (y) (list 'OBJ (cons "breite_mm" (car y)) (cons "anzahl" (cadr y))
(cons "laenge_mm" (caddr y)) (cons "flaeche_mm2" (cadddr y))))
(vl-sort (nth 5 x) '(lambda (a b) (< (car a) (car b))))))))))
erg))
)
@@ -2311,12 +2366,22 @@
(cons key (list 'OBJ (cons "formel" formel) (cons "quelle" quelle)))
)
;; Huelle einer bbox (ARR xmin ymin xmax ymax) als OBJ, nil ohne bbox.
(defun lg-huelle (bbox / b dx dy)
(if (setq b (cdr bbox))
(progn
(setq dx (- (caddr b) (car b)) dy (- (cadddr b) (cadr b)))
(list 'OBJ (cons "bbox" bbox) (cons "laenge_mm" (max dx dy)) (cons "breite_mm" (min dx dy)))))
)
;; Kennwerte eines Geschosses. g = Geschoss-Record, nx = Record des
;; naechsthoeheren Geschosses (nil = oberstes), reihen/gaenge = Records
;; dieses Geschosses (Reihen mit unter_reihe/gitterkorb), n-bereiche =
;; Anzahl Bereiche. Rueckgabe (kennwerte herkunft), beide OBJ.
;; Anzahl Bereiche. Rueckgabe (kennwerte herkunft), beide OBJ. Felder, die
;; nicht zutreffen (Belag/Gitterrost/Gitterkorb auf Hallenboden), sind
;; ENTFAELLT; nil = nicht berechenbar (fehlende Eingabe).
(defun lg-kennwerte-geschoss (g nx reihen gaenge n-bereiche / nrs q qr buehne hk lichte regal grund
schienen gitter-r korb gk l f belag-g gitter-g belag gitter)
rohr gitter-r offen-r korb gk l f u belag-g gitter-g belag gitter)
(setq nrs (vl-princ-to-string (lg-j g "nr"))
q (strcat "LG_GESCHOSS " nrs)
qr (strcat (itoa (length reihen)) " Regalreihe(n) LG_REIHE_* Geschoss " nrs)
@@ -2324,8 +2389,8 @@
hk nil)
;; lichte Hoehe: Vorgabe am Geschoss, sonst aus dem Geschoss darueber
(cond
((numberp (lg-j g "lichte_hoehe_mm"))
(setq lichte (lg-j g "lichte_hoehe_mm")
((numberp (lg-j g "lichte_hoehe_vorgabe_mm"))
(setq lichte (lg-j g "lichte_hoehe_vorgabe_mm")
hk (cons (lg-herkunft "lichte_hoehe_mm" "LICHTE_HOEHE_mm (Vorgabe am Geschoss)" q) hk)))
(nx
(setq lichte (- (lg-n (lg-j nx "hoehe_belag_mm")) (lg-n (lg-j nx "konstr_hoehe_mm"))
@@ -2334,31 +2399,37 @@
"HOEHE_BELAG_mm darueber - KONSTR_HOEHE_mm darueber - eigene HOEHE_BELAG_mm"
(strcat q " / " (vl-princ-to-string (lg-j nx "nr"))))
hk)))
(T (setq lichte nil))
(T (setq lichte nil
hk (cons (lg-herkunft "lichte_hoehe_mm"
"oberstes Geschoss ohne LICHTE_HOEHE_mm: nicht berechenbar (Eingabe fehlt)" q) hk)))
)
;; Regalreihen
(setq regal 0.0 grund 0.0 schienen 0.0 gitter-r 0.0 korb (list 0 0.0 0.0 0.0 0.0))
(setq regal 0.0 grund 0.0 rohr 0.0 gitter-r 0.0 offen-r 0.0 korb (list 0 0.0 0.0 0.0 0.0))
(foreach r reihen
(setq l (lg-n (lg-j r "laenge_mm"))
f (* l (lg-n (lg-j r "tiefe_mm"))))
f (* l (lg-n (lg-j r "tiefe_mm")))
u (lg-j r "unter_reihe"))
(setq regal (+ regal l) grund (+ grund f)
schienen (+ schienen (* l (if (numberp (lg-j r "schienen")) (lg-j r "schienen") 1))))
rohr (+ rohr (* l (length (cdr (lg-j r "haengeebenen"))))))
(cond
((equal (lg-j r "unter_reihe") "gitterrost") (setq gitter-r (+ gitter-r f)))
((equal u "gitterrost") (setq gitter-r (+ gitter-r f)))
((setq gk (lg-j r "gitterkorb"))
(setq korb (list (1+ (nth 0 korb))
(+ (nth 1 korb) (lg-n (lg-j gk "bodenflaeche_mm2")))
(+ (nth 2 korb) (lg-n (lg-j gk "seitenflaeche_mm2")))
(+ (nth 3 korb) (lg-n (lg-j gk "offen_laengs_mm")))
(+ (nth 4 korb) (lg-n (lg-j gk "offen_stirn_mm")))))))
(+ (nth 4 korb) (lg-n (lg-j gk "offen_stirn_mm"))))))
((equal u "keine") (setq offen-r (+ offen-r f))))
)
(setq hk (append (reverse
(list (lg-herkunft "regallaenge_mm" "Summe LAENGE der Regalreihen" qr)
(lg-herkunft "regalgrundflaeche_mm2" "Summe LAENGE x TIEFE_mm der Regalreihen" qr)
(lg-herkunft "schienenlaenge_mm" "Summe LAENGE x SCHIENEN der Regalreihen" qr)
(lg-herkunft "regalrohrlaenge_mm"
"Summe LAENGE x Anzahl Haengeebenen der Regalreihen (Regalrohr je Haengeebene; Trolley-Schienen nicht enthalten)" qr)
(lg-herkunft "haengeebenen" "je Schienenhoehe/Warenlaenge: Summe LAENGE aller Reihen mit dieser Haengeebene" qr)
(lg-herkunft "gaenge" "je ART: Anzahl, Summe LAENGE, Summe LAENGE x BREITE_mm"
(strcat (itoa (length gaenge)) " Flaeche(n) LG_GANG_* Geschoss " nrs))))
(lg-herkunft "gaenge" "je ART: Anzahl, Summe LAENGE, Summe LAENGE x BREITE_mm, Anzahl quer zur Reihenrichtung, Aufteilung nach BREITE_mm"
(strcat (itoa (length gaenge)) " Flaeche(n) LG_GANG_* Geschoss " nrs))
(lg-herkunft "huelle" "achsparallele Huelle der Belagskontur, laenge_mm = laengere Seite" q)))
hk))
;; Belag und Gitterrost (nur Buehne)
(setq belag-g 0.0 gitter-g 0.0)
@@ -2387,28 +2458,35 @@
(strcat "Reihen mit UNTER_REIHE gitterkorb: Boden = LAENGE x TIEFE_mm,"
" Seiten = offene Kantenlaenge x GITTERKORB_HOEHE_mm"
" (Kanten an einer direkt anliegenden Nachbarreihe zaehlen nicht)")
qr) hk))
(setq hk (cons (lg-herkunft "ohne_absturzsicherung_mm2"
"LAENGE x TIEFE_mm der Reihen mit UNTER_REIHE keine (offene Flaeche zum Geschoss darunter)"
qr) hk)))
(setq belag nil gitter nil
hk (cons (lg-herkunft "buehne" "BELAG_ART hallenboden (oder leer): keine Buehne, kein Belag/Gitterrost/Gitterkorb" q) hk))
(setq belag 'ENTFAELLT gitter 'ENTFAELLT
hk (cons (lg-herkunft "buehne" "BELAG_ART hallenboden (oder leer): keine Buehne - Belag, Gitterrost, Gitterkorb und Absturzsicherung entfallen" q) hk))
)
(list
(list 'OBJ
(cons "lichte_hoehe_mm" lichte)
(cons "buehne" (if buehne T 'FALSE))
(cons "huelle" (lg-huelle (lg-j (lg-j g "kontur") "bbox")))
(cons "bereiche" n-bereiche)
(cons "reihen" (length reihen))
(cons "regallaenge_mm" regal)
(cons "regalgrundflaeche_mm2" grund)
(cons "schienenlaenge_mm" schienen)
(cons "regalrohrlaenge_mm" rohr)
(cons "haengeebenen" (lg-haengeebenen-summen reihen))
(cons "gaenge" (lg-gaenge-je-art gaenge))
(cons "belagsflaeche_mm2" belag)
(cons "gitterrostflaeche_mm2" gitter)
(cons "gitterkorb" (list 'OBJ (cons "reihen" (nth 0 korb))
(cons "bodenflaeche_mm2" (nth 1 korb))
(cons "seitenflaeche_mm2" (nth 2 korb))
(cons "offen_laengs_mm" (nth 3 korb))
(cons "offen_stirn_mm" (nth 4 korb)))))
(cons "gitterkorb" (if buehne
(list 'OBJ (cons "reihen" (nth 0 korb))
(cons "bodenflaeche_mm2" (nth 1 korb))
(cons "seitenflaeche_mm2" (nth 2 korb))
(cons "offen_laengs_mm" (nth 3 korb))
(cons "offen_stirn_mm" (nth 4 korb)))
'ENTFAELLT))
(cons "ohne_absturzsicherung_mm2" (if buehne offen-r 'ENTFAELLT)))
(cons 'OBJ (reverse hk)))
)
@@ -2416,36 +2494,134 @@
(apply '+ (cons 0.0 (mapcar '(lambda (o) (lg-n (lg-j o key))) objs)))
)
;; Kennwerte des ganzen Lagers. geschosse = Geschoss-Records mit kennwerte
;; und kontur, reihen/gaenge = alle einem Geschoss zugeordneten Records.
(defun lg-kennwerte-lager (geschosse reihen gaenge n-bereiche / kws korb bbs xmin ymin xmax ymax dx dy)
;; Kennwerte des ganzen Lagers. geschosse = Geschoss-Records mit kennwerte,
;; reihen/gaenge = alle einem Geschoss zugeordneten Records. Die Summen
;; stehen ausdruecklich unter summe_alle_geschosse; grundriss_max ist der
;; groesste Geschossgrundriss (die Geschosse koennen im Plan nebeneinander
;; liegen - eine gemeinsame Huelle waere kein Gebaeudemass).
(defun lg-kennwerte-lager (geschosse reihen gaenge n-bereiche / kws korb hs)
(setq kws (mapcar '(lambda (g) (lg-j g "kennwerte")) geschosse)
korb (mapcar '(lambda (k) (lg-j k "gitterkorb")) kws)
bbs (vl-remove nil (mapcar '(lambda (g) (cdr (lg-j (lg-j g "kontur") "bbox"))) geschosse)))
(if bbs
(setq xmin (apply 'min (mapcar 'car bbs)) ymin (apply 'min (mapcar 'cadr bbs))
xmax (apply 'max (mapcar 'caddr bbs)) ymax (apply 'max (mapcar 'cadddr bbs))
dx (- xmax xmin) dy (- ymax ymin)))
korb (vl-remove nil (mapcar '(lambda (k) (lg-j k "gitterkorb")) kws))
hs (vl-remove nil (mapcar '(lambda (k) (lg-j k "huelle")) kws)))
(list 'OBJ
(cons "geschosse" (length geschosse))
(cons "bereiche" n-bereiche)
(cons "reihen" (length reihen))
(cons "regallaenge_mm" (lg-summe-feld kws "regallaenge_mm"))
(cons "regalgrundflaeche_mm2" (lg-summe-feld kws "regalgrundflaeche_mm2"))
(cons "schienenlaenge_mm" (lg-summe-feld kws "schienenlaenge_mm"))
(cons "haengeebenen" (lg-haengeebenen-summen reihen))
(cons "gaenge" (lg-gaenge-je-art gaenge))
(cons "belagsflaeche_mm2" (lg-summe-feld kws "belagsflaeche_mm2"))
(cons "gitterrostflaeche_mm2" (lg-summe-feld kws "gitterrostflaeche_mm2"))
(cons "gitterkorb" (list 'OBJ (cons "reihen" (fix (lg-summe-feld korb "reihen")))
(cons "bodenflaeche_mm2" (lg-summe-feld korb "bodenflaeche_mm2"))
(cons "seitenflaeche_mm2" (lg-summe-feld korb "seitenflaeche_mm2"))
(cons "offen_laengs_mm" (lg-summe-feld korb "offen_laengs_mm"))
(cons "offen_stirn_mm" (lg-summe-feld korb "offen_stirn_mm"))))
(cons "huelle" (if bbs
(list 'OBJ (cons "bbox" (list 'ARR xmin ymin xmax ymax))
(cons "laenge_mm" (max dx dy))
(cons "breite_mm" (min dx dy))))))
(cons "grundriss_max" (if hs
(list 'OBJ (cons "laenge_mm" (apply 'max (mapcar '(lambda (h) (lg-j h "laenge_mm")) hs)))
(cons "breite_mm" (apply 'max (mapcar '(lambda (h) (lg-j h "breite_mm")) hs))))))
(cons "summe_alle_geschosse"
(list 'OBJ
(cons "reihen" (length reihen))
(cons "regallaenge_mm" (lg-summe-feld kws "regallaenge_mm"))
(cons "regalgrundflaeche_mm2" (lg-summe-feld kws "regalgrundflaeche_mm2"))
(cons "regalrohrlaenge_mm" (lg-summe-feld kws "regalrohrlaenge_mm"))
(cons "haengeebenen" (lg-haengeebenen-summen reihen))
(cons "gaenge" (lg-gaenge-je-art gaenge))
(cons "belagsflaeche_mm2" (lg-summe-feld kws "belagsflaeche_mm2"))
(cons "gitterrostflaeche_mm2" (lg-summe-feld kws "gitterrostflaeche_mm2"))
(cons "gitterkorb" (list 'OBJ (cons "reihen" (fix (lg-summe-feld korb "reihen")))
(cons "bodenflaeche_mm2" (lg-summe-feld korb "bodenflaeche_mm2"))
(cons "seitenflaeche_mm2" (lg-summe-feld korb "seitenflaeche_mm2"))
(cons "offen_laengs_mm" (lg-summe-feld korb "offen_laengs_mm"))
(cons "offen_stirn_mm" (lg-summe-feld korb "offen_stirn_mm"))))
(cons "ohne_absturzsicherung_mm2" (lg-summe-feld kws "ohne_absturzsicherung_mm2")))))
)
;; --- Plausibilitaet (reiner Kern, getestet) ---
;; Prueft ein Geschoss auf Eingaben, die fuer die Ausschreibung kaum stimmen
;; koennen. grenzen = Alist aus dem Regelwerk (("gang_min" wert quelle)
;; ("lichte_min" wert quelle)), fehlende Grenzen werden nicht geprueft.
;; Rueckgabe: Liste von Warntexten.
(defun lg-plausibilitaet (g kw reihen gaenge grenzen / nrs w buehne gm lm schmal quer rand neben
ebenen-texte frei top lichte)
(setq nrs (vl-princ-to-string (lg-j g "nr")) w nil
buehne (lg-buehne-p (lg-j g "belag_art"))
lichte (lg-j kw "lichte_hoehe_mm")
gm (cdr (assoc "gang_min" grenzen))
lm (cdr (assoc "lichte_min" grenzen)))
;; Buehne ohne Konstruktionshoehe
(if (and buehne (<= (lg-n (lg-j g "konstr_hoehe_mm")) 0.0))
(setq w (cons (ssg-textf "lg-pl-konstr-null" (list nrs)) w)))
;; Buehne mit offenen Flaechen unter Reihen
(if (and buehne (> (lg-n (lg-j kw "ohne_absturzsicherung_mm2")) 0.0))
(setq w (cons (ssg-textf "lg-pl-unter-keine"
(list nrs (rtos (/ (lg-j kw "ohne_absturzsicherung_mm2") 1.0e6) 2 1))) w)))
;; lichte Hoehe unter dem Regelwerk
(if (and lm (numberp lichte) (< lichte (car lm)))
(setq w (cons (ssg-textf "lg-pl-lichte-klein"
(list nrs (lg-mm-str lichte) (lg-mm-str (car lm)) (cadr lm))) w)))
;; zu schmale Gaenge
(if gm
(progn
(setq schmal (vl-remove-if-not '(lambda (x) (< (lg-n (lg-j x "breite_mm")) (car gm))) gaenge))
(if schmal
(setq w (cons (ssg-textf "lg-pl-gang-schmal"
(list nrs (itoa (length schmal))
(ssg-join (lg-unikat (mapcar '(lambda (x) (lg-mm-str (lg-j x "breite_mm"))) schmal)) ", ")
(lg-mm-str (car gm)) (cadr gm))) w)))))
;; als "gang" eingetragen, liegt aber quer zur Reihenrichtung
(setq quer (vl-remove-if-not '(lambda (x) (and (equal (lg-j x "art") "gang")
(equal (lg-j x "ausrichtung") "quer")))
gaenge))
(if quer
(setq w (cons (ssg-textf "lg-pl-gang-quer"
(list nrs (itoa (length quer)) (ssg-join (mapcar '(lambda (x) (vl-princ-to-string (lg-j x "id"))) quer) ", ")))
w)))
;; Gang direkt neben einem Randgang (doppelte Randzone?)
(setq rand (mapcar '(lambda (x) (mapcar 'cdr (cdr (lg-j x "ecken"))))
(vl-remove-if-not '(lambda (x) (equal (lg-j x "art") "randgang")) gaenge)))
(if rand
(progn
(setq neben (vl-remove-if-not
'(lambda (x / e k)
(if (not (equal (lg-j x "art") "randgang"))
(progn
(setq e (mapcar 'cdr (cdr (lg-j x "ecken"))) k (lg-rechteck-kanten e))
(vl-some '(lambda (kante / len)
(setq len (distance (car kante) (cadr kante)))
(< (lg-kante-offen kante rand 1.0) (- len 1.0)))
(list (nth 0 k) (nth 2 k))))))
gaenge))
(if neben
(setq w (cons (ssg-textf "lg-pl-gang-neben-randgang"
(list nrs (itoa (length neben)) (ssg-join (mapcar '(lambda (x) (vl-princ-to-string (lg-j x "id"))) neben) ", ")))
w)))))
;; Haengeebenen: kein Freiraum unter der Ware, oberste Schiene ueber der lichten Hoehe
(setq ebenen-texte nil top nil)
(foreach r reihen
(foreach e (cdr (lg-j r "haengeebenen"))
(if (or (null top) (> (lg-n (lg-j e "schienenhoehe_mm")) top)) (setq top (lg-n (lg-j e "schienenhoehe_mm"))))
(if (<= (lg-n (lg-j e "freiraum_unter_mm")) 0.0)
(setq ebenen-texte (cons (strcat (lg-mm-str (lg-j e "schienenhoehe_mm")) "/" (lg-mm-str (lg-j e "warenlaenge_mm"))
" (" (lg-mm-str (lg-j e "freiraum_unter_mm")) ")")
ebenen-texte)))))
(if ebenen-texte
(setq w (cons (ssg-textf "lg-pl-freiraum" (list nrs (ssg-join (lg-unikat (reverse ebenen-texte)) ", "))) w)))
(if (and top (numberp lichte) (>= top lichte))
(setq w (cons (ssg-textf "lg-pl-schiene-ueber-lichte" (list nrs (lg-mm-str top) (lg-mm-str lichte))) w)))
(reverse w)
)
;; Liste ohne Wiederholungen, Reihenfolge des ersten Auftretens.
(defun lg-unikat (l / erg)
(foreach x l (if (not (member x erg)) (setq erg (cons x erg))))
(reverse erg)
)
;; Grenzwerte fuer lg-plausibilitaet aus dem Regelprofil des Landes, mit
;; dem Geschoss als Kontext. Fehlt das Profil, bleibt die Liste leer.
(defun lg-plausibilitaet-grenzen (g land / kontext regel erg w)
(setq kontext (vl-remove-if '(lambda (p) (null (cdr p)))
(list (cons "brandgefaehrdung" (lg-j g "brandgefaehrdung"))
(cons "personen" (lg-j g "personen"))))
erg nil)
(foreach p '(("gang_min" . "gang.breite_nebengang_min") ("lichte_min" . "lichte_hoehe.verkehrsweg_min"))
(if (and (car (atoms-family 1 '("LG-REGEL-AUFLOESEN")))
(setq regel (lg-regel-finden (lg-profil land) (cdr p)))
(setq w (lg-regel-aufloesen regel kontext))
(numberp (car w)))
(setq erg (cons (list (car p) (float (car w)) (strcat (cdr p) ": " (lg-eintrag-quelle (cadr w)))) erg))))
erg
)
;; --- Records aus der Zeichnung ---
@@ -2473,7 +2649,8 @@
(cons "layer" (lg-ent-layer (car g)))
(cons "hoehe_belag_mm" (lg-a-zahl a "HOEHE_BELAG_mm"))
(cons "konstr_hoehe_mm" (lg-a-zahl a "KONSTR_HOEHE_mm"))
(cons "lichte_hoehe_mm" (lg-a-zahl a "LICHTE_HOEHE_mm"))
;; nur die Eingabe am Geschoss; der wirksame Wert steht in kennwerte
(cons "lichte_hoehe_vorgabe_mm" (cond ((lg-a-zahl a "LICHTE_HOEHE_mm")) ('ENTFAELLT)))
(cons "belag_art" (cdr (assoc "BELAG_ART" a)))
(cons "personen" (lg-a-int a "PERSONEN"))
(cons "brandgefaehrdung" (cdr (assoc "BRANDGEFAEHRDUNG" a)))
@@ -2490,7 +2667,8 @@
(cons "gangbreite_mm" (lg-a-zahl a "GANGBREITE_mm"))
(cons "regaltiefe_mm" (lg-a-zahl a "REGALTIEFE_mm"))
(cons "reihen_je_gang" (lg-a-int a "REIHEN_JE_GANG"))
(cons "schienen_je_gang" (lg-a-int a "SCHIENEN_JE_GANG"))
;; Trolley-Schienen je Gang: Eingabe, wird noch nicht ausgewertet
(cons "trolleyschienen_je_gang" (lg-a-int a "SCHIENEN_JE_GANG"))
(cons "quergang_abstand_mm" (lg-a-zahl a "QUERGANG_ABSTAND_mm"))
(cons "quergang_breite_mm" (lg-a-zahl a "QUERGANG_BREITE_mm"))
(cons "richtung_grad" (lg-a-zahl a "RICHTUNG"))
@@ -2508,8 +2686,8 @@
;; Reihe oder Gang: Attribute plus Geometrie (Start/Ende/Mitte in WCS mit Z,
;; Ecken des Grundrisses 2D aus lg-linie-polygon).
(defun lg-export-linie-rec (e art / a ed p1 z rot l b p2 quelle)
(setq a (ssg-attrib-read e) ed (entget e)
(defun lg-export-linie-rec (e art / a ed p1 z rot l b p2 quelle bh)
(setq a (ssg-attrib-read e) ed (entget e) bh (lg-xdata-wert e "bereich")
p1 (cdr (assoc 10 ed)) z (cond ((caddr p1)) (0.0))
rot (cond ((cdr (assoc 50 ed))) (0.0))
l (lg-a-zahl a "LAENGE")
@@ -2523,13 +2701,13 @@
(cons "handle" (lg-handle e))
(cons "layer" (lg-ent-layer e))
(cons "geschoss" (lg-a-int a "GESCHOSS"))
(cons "bereich" (lg-a-int a "BEREICH"))
(cons "bereich_handle" (lg-xdata-wert e "bereich"))
;; ohne Bereich (frei gesetzt) entfallen beide Felder
(cons "bereich" (if bh (lg-a-int a "BEREICH") 'ENTFAELLT))
(cons "bereich_handle" (if bh bh 'ENTFAELLT))
(cons "quelle" quelle)
(cons "laenge_mm" l))
(if (= art "reihe")
(list (cons "tiefe_mm" b)
(cons "schienen" (lg-a-int a "SCHIENEN"))
(cons "haengeebenen" (lg-j-ebenen (cdr (assoc "HAENGEEBENEN" a)))))
(list (cons "breite_mm" b)
(cons "art" (cdr (assoc "ART" a)))
@@ -2556,12 +2734,25 @@
"gitterkorb"
(if (= u "gitterkorb")
(list 'OBJ (cons "hoehe_mm" (cond ((lg-j br "gitterkorb_hoehe_mm"))
((lg-zahl (lg-vorgabe '("bereich" "gitterkorb_hoehe_mm") nil)))))))))
((lg-zahl (lg-vorgabe '("bereich" "gitterkorb_hoehe_mm") nil))))))
'ENTFAELLT)))
reihen)
)
;; ausrichtung je Gang (laengs/quer) gegen die Reihenrichtung seines Bereichs;
;; ohne Bereich entfaellt das Feld.
(defun lg-gaenge-ausrichtung-setzen (gaenge bereiche / br)
(mapcar
'(lambda (x / br)
(setq br (if (lg-j x "bereich_handle")
(vl-some '(lambda (b) (if (equal (lg-j b "handle") (lg-j x "bereich_handle")) b)) bereiche)))
(lg-j-setzen x "ausrichtung"
(cond ((lg-ausrichtung (lg-j x "winkel_grad") (lg-j br "richtung_grad"))) ('ENTFAELLT))))
gaenge)
)
;; Alle Daten des Lagers als OBJ (Grundlage von lg-export-json).
(defun lg-export-daten ( / warn gs bereiche reihen gaenge g-recs vorgabe g-neu r-neu r-gs g-gs i g nx nr nrs kw)
(defun lg-export-daten ( / warn gs bereiche reihen gaenge g-recs vorgabe g-neu r-neu r-gs g-gs i g nx nr nrs kw t1)
(setq gs (lg-geschosse) warn nil vorgabe (lg-unter-reihe-vorgabe))
(if (null gs) (setq warn (cons (ssg-text "lg-exp-keine-geschosse") warn)))
(foreach g gs
@@ -2575,7 +2766,8 @@
'(lambda (a b / ha hb)
(setq ha (lg-n (lg-j a "hoehe_belag_mm")) hb (lg-n (lg-j b "hoehe_belag_mm")))
(if (equal ha hb 1e-6) (< (lg-j a "nr") (lg-j b "nr")) (< ha hb)))))
(setq reihen (lg-reihen-unter-setzen reihen bereiche g-recs vorgabe))
(setq reihen (lg-reihen-unter-setzen reihen bereiche g-recs vorgabe)
gaenge (lg-gaenge-ausrichtung-setzen gaenge bereiche))
(setq g-neu nil r-neu nil r-gs nil g-gs nil i 0)
(foreach g g-recs
(setq nr (lg-j g "nr")
@@ -2592,6 +2784,9 @@
(if (and (equal (lg-j b "geschoss") nr) (= (lg-j b "unter_reihe") "gitterkorb"))
(setq warn (cons (ssg-textf "lg-exp-korb-hallenboden"
(list (vl-princ-to-string (lg-j b "nr")) (itoa nr))) warn)))))
;; Plausibilitaet gegen das Regelprofil (nur Warnungen)
(foreach t1 (lg-plausibilitaet g (car kw) r-gs g-gs (lg-plausibilitaet-grenzen g (lg-land)))
(setq warn (cons t1 warn)))
(setq g-neu (cons (lg-j-setzen (lg-j-setzen g "kennwerte" (car kw)) "herkunft" (cadr kw)) g-neu)
r-neu (append r-neu r-gs)
i (1+ i)))