[CHANGE] Lager-Export nur noch als JSON mit Kennwerten, Gitterkorb unter Regalreihen
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Simon HenschandClaude Opus 5.5 committed
1 parent
3c729ea604
commit
d2729140ff
22 files changed
+1068
-1089
No files matched your search
+566
-143
@@ -2,8 +2,8 @@
|
||||
;; LagerInsert.lsp - Lagerplanung GOH-Buehnenlager (Phase 1: Mengen, 2D)
|
||||
;;
|
||||
;; Erzeugt parametrische Attributbloecke fuer ein mehrgeschossiges
|
||||
;; Haengewarenlager und sammelt daraus die Mengen fuer die RFQ-YAML
|
||||
;; (Overlay, siehe doc/plan/lager_rfq.md):
|
||||
;; Haengewarenlager und exportiert daraus die technischen Daten als JSON
|
||||
;; fuer die RFQ-Dokumentation (LAGER_EXPORT, siehe doc/plan/lager_rfq.md):
|
||||
;;
|
||||
;; LG_GESCHOSS Geschoss-Kopfsymbol, verknuepft mit seiner Belagskontur
|
||||
;; LG_BEREICH Lagerbereich (Kontur + Parameter), fuellt sich selbst
|
||||
@@ -13,7 +13,7 @@
|
||||
;; je Belag aus lager.json belag_schraffur)
|
||||
;;
|
||||
;; Befehle: LG_GESCHOSS, LG_GESCHOSS_AKTIV, LG_GESCHOSS_KOPIEREN, LG_BEREICH,
|
||||
;; LG_REIHE, LG_GANG, LG_EDIT, LG_REGALE, LAGER_EXPORT, LAGER_HAND_YAML
|
||||
;; LG_REIHE, LG_GANG, LG_EDIT, LG_REGALE, LAGER_EXPORT
|
||||
;;
|
||||
;; Grundsaetze (CLAUDE.md):
|
||||
;; - Alle Werte selbstbeschreibend in mm/Grad, keine Index-Codes.
|
||||
@@ -379,6 +379,7 @@
|
||||
("SCHIENEN_JE_GANG" . "") ("QUERGANG_ABSTAND_mm" . "") ("QUERGANG_BREITE_mm" . "")
|
||||
("RICHTUNG" . "") ("HAENGEEBENEN" . "") ("BELAG" . "")
|
||||
("RANDGANG_N_mm" . "0") ("RANDGANG_O_mm" . "0") ("RANDGANG_S_mm" . "0") ("RANDGANG_W_mm" . "0")
|
||||
("UNTER_REIHE" . "") ("GITTERKORB_HOEHE_mm" . "")
|
||||
("RESTBREITE_mm" . "")))
|
||||
|
||||
(setq *lg-schema-reihe*
|
||||
@@ -621,6 +622,8 @@
|
||||
("richtung" "RICHTUNG" "grad" nil)
|
||||
("ebenen" "HAENGEEBENEN" "ebenen" nil)
|
||||
("belag" "BELAG" "wahl" belag)
|
||||
("unter" "UNTER_REIHE" "wahl" unter)
|
||||
("korbhoehe" "GITTERKORB_HOEHE_mm" "mm" nil)
|
||||
("rand_n" "RANDGANG_N_mm" "mm" nil)
|
||||
("rand_o" "RANDGANG_O_mm" "mm" nil)
|
||||
("rand_s" "RANDGANG_S_mm" "mm" nil)
|
||||
@@ -653,6 +656,7 @@
|
||||
((eq sym 'brand) (lg-vorgabe '("brandgefaehrdungen") '("normal" "erhoeht_mit_loeschanlage" "erhoeht_ohne_loeschanlage")))
|
||||
((eq sym 'reihen) '("1" "2"))
|
||||
((eq sym 'gangart) '("gang" "randgang" "quergang"))
|
||||
((eq sym 'unter) *lg-unter-reihe-werte*)
|
||||
((eq sym 'geschosse) (mapcar '(lambda (g) (itoa (cadr g))) (lg-geschosse)))
|
||||
)
|
||||
)
|
||||
@@ -1174,12 +1178,36 @@
|
||||
(cons "RICHTUNG" (lg-mm-str (if pts (lg-kontur-richtung pts) 0.0)))
|
||||
(cons "HAENGEEBENEN" (lg-vorgabe '("reihe" "haengeebenen") "2300/1200;1100/1100"))
|
||||
(cons "BELAG" (lg-vorgabe '("bereich" "belag") "spanplatte"))
|
||||
(cons "UNTER_REIHE" (lg-unter-reihe-vorgabe))
|
||||
(cons "GITTERKORB_HOEHE_mm" (lg-mm-str (lg-zahl (lg-vorgabe '("bereich" "gitterkorb_hoehe_mm") 500))))
|
||||
(cons "RANDGANG_N_mm" (lg-mm-str (lg-zahl (lg-vorgabe '("bereich" "randgang_mm" "n") 0))))
|
||||
(cons "RANDGANG_O_mm" (lg-mm-str (lg-zahl (lg-vorgabe '("bereich" "randgang_mm" "o") 0))))
|
||||
(cons "RANDGANG_S_mm" (lg-mm-str (lg-zahl (lg-vorgabe '("bereich" "randgang_mm" "s") 0))))
|
||||
(cons "RANDGANG_W_mm" (lg-mm-str (lg-zahl (lg-vorgabe '("bereich" "randgang_mm" "w") 0)))))
|
||||
)
|
||||
|
||||
;; Absturzsicherung unter den Regalreihen (Attribut UNTER_REIHE am Bereich):
|
||||
;; gitterrost = Grundflaeche der Reihe als Gitterrost, gitterkorb = Korb mit
|
||||
;; Boden UND Seitenwaenden zum Geschoss darunter, keine = offen.
|
||||
(setq *lg-unter-reihe-werte* '("gitterrost" "gitterkorb" "keine"))
|
||||
|
||||
(defun lg-unter-reihe-vorgabe ( / v)
|
||||
(setq v (lg-vorgabe '("bereich" "unter_reihe") "gitterrost"))
|
||||
(if (member v *lg-unter-reihe-werte*) v "gitterrost")
|
||||
)
|
||||
|
||||
;; Reiner Kern: wirksamer Wert unter einer Reihe. wert = UNTER_REIHE des
|
||||
;; Bereichs (nil/leer/unbekannt -> vorgabe), buehne-p = nil auf Hallenboden
|
||||
;; (dort gibt es nichts abzusichern -> "keine").
|
||||
(defun lg-unter-reihe-wert (wert vorgabe buehne-p)
|
||||
(cond
|
||||
((not buehne-p) "keine")
|
||||
((member wert *lg-unter-reihe-werte*) wert)
|
||||
((member vorgabe *lg-unter-reihe-werte*) vorgabe)
|
||||
(T "gitterrost")
|
||||
)
|
||||
)
|
||||
|
||||
;; Randgang-Breiten eines Bereichs (Attribute) fuer lg-fuellung-berechnen.
|
||||
;; Fehlt ein Attribut (Altbestand), gilt 0.
|
||||
(defun lg-bereich-rand (a)
|
||||
@@ -2011,11 +2039,21 @@
|
||||
)
|
||||
|
||||
;; ============================================================
|
||||
;; EXPORT (lager_raw.json)
|
||||
;; EXPORT (<dwg>_lager.json)
|
||||
;; ============================================================
|
||||
;; Eine JSON-Datei mit den technischen Daten des Lagers fuer die
|
||||
;; RFQ-Dokumentation (eigenes Projekt): alle Objekte mit Attributen und
|
||||
;; voller Geometrie (WCS, mm) plus Kennwerte je Geschoss und fuer das ganze
|
||||
;; Lager, jeder Geschoss-Kennwert mit Formel und Quelle (herkunft).
|
||||
;; Schema und Formeln: doc/plan/lager_rfq.md. Die Kennwerte entstehen hier
|
||||
;; in reinen Kernen (getestet) - fachliche Regeln leben in LISP.
|
||||
;;
|
||||
;; Datenform: Objekte als (OBJ (schluessel . wert) ...), Arrays als
|
||||
;; (ARR wert ...); lg-j liest ein Feld, lg-j-setzen setzt es.
|
||||
|
||||
;; --- JSON-Schreiber (rein, getestet) ---
|
||||
;; Werte: nil -> null, T -> true, String, Ganz-/Fliesszahl, (ROH "json").
|
||||
;; Werte: nil -> null, T -> true, FALSE -> false, String, Ganz-/Fliesszahl,
|
||||
;; (ROH "json"), (OBJ ...) -> Objekt, (ARR ...) -> Array.
|
||||
(defun lg-json-zahl (w / s)
|
||||
(setq s (rtos w 2 3))
|
||||
(if (vl-string-search "." s)
|
||||
@@ -2025,141 +2063,564 @@
|
||||
(if (= s "-0") "0" s)
|
||||
)
|
||||
|
||||
(defun lg-hex4 (n / h erg)
|
||||
(setq h "0123456789abcdef" erg "")
|
||||
(repeat 4
|
||||
(setq erg (strcat (substr h (1+ (rem n 16)) 1) erg) n (/ n 16)))
|
||||
erg
|
||||
)
|
||||
|
||||
;; String als JSON-Text. Zeichen ausserhalb ASCII (Umlaute in einer
|
||||
;; Bezeichnung) als \uXXXX, damit die Datei unabhaengig von der Codepage
|
||||
;; gueltiges UTF-8 bleibt.
|
||||
(defun lg-json-str (s / roh i c erg)
|
||||
(setq roh (ssg-json-escape s) erg "" i 1)
|
||||
(while (<= i (strlen roh))
|
||||
(setq c (substr roh i 1))
|
||||
(setq erg (strcat erg (if (> (ascii c) 127) (strcat "\\u" (lg-hex4 (ascii c))) c))
|
||||
i (1+ i)))
|
||||
(strcat "\"" erg "\"")
|
||||
)
|
||||
|
||||
(defun lg-json-wert (v)
|
||||
(cond
|
||||
((null v) "null")
|
||||
((eq v T) "true")
|
||||
((= (type v) 'STR) (strcat "\"" (ssg-json-escape v) "\""))
|
||||
((eq v 'FALSE) "false")
|
||||
((= (type v) 'STR) (lg-json-str v))
|
||||
((= (type v) 'INT) (itoa v))
|
||||
((= (type v) 'REAL) (lg-json-zahl v))
|
||||
((and (listp v) (eq (car v) 'ROH)) (cadr v))
|
||||
(T (strcat "\"" (ssg-json-escape (vl-princ-to-string v)) "\""))
|
||||
((and (listp v) (eq (car v) 'OBJ)) (lg-json-obj (cdr v)))
|
||||
((and (listp v) (eq (car v) 'ARR))
|
||||
(strcat "[" (ssg-join (mapcar 'lg-json-wert (cdr v)) ", ") "]"))
|
||||
(T (lg-json-str (vl-princ-to-string v)))
|
||||
)
|
||||
)
|
||||
|
||||
(defun lg-json-obj (paare)
|
||||
(strcat "{"
|
||||
(ssg-join (mapcar '(lambda (p) (strcat "\"" (car p) "\": " (lg-json-wert (cdr p)))) paare)
|
||||
(ssg-join (mapcar '(lambda (p) (strcat (lg-json-str (car p)) ": " (lg-json-wert (cdr p)))) paare)
|
||||
", ")
|
||||
"}")
|
||||
)
|
||||
|
||||
;; Liste bereits gerenderter JSON-Texte als Array (ein Element je Zeile).
|
||||
(defun lg-json-arr (texte einrueckung)
|
||||
(if texte
|
||||
(strcat "[\n" einrueckung (ssg-join texte (strcat ",\n" einrueckung)) "\n" (substr einrueckung 3) "]")
|
||||
"[]")
|
||||
(defun lg-json-container-p (v)
|
||||
(and v (listp v) (member (car v) '(OBJ ARR)))
|
||||
)
|
||||
|
||||
(defun lg-json-zahlen (zahlen)
|
||||
(list 'ROH (strcat "[" (ssg-join (mapcar 'lg-json-wert zahlen) ", ") "]"))
|
||||
;; Anzahl Blattwerte eines Werts (Mass fuer "passt in eine Zeile").
|
||||
(defun lg-json-blaetter (v)
|
||||
(cond
|
||||
((not (lg-json-container-p v)) 1)
|
||||
((eq (car v) 'OBJ) (apply '+ (cons 0 (mapcar '(lambda (p) (lg-json-blaetter (cdr p))) (cdr v)))))
|
||||
(T (apply '+ (cons 0 (mapcar 'lg-json-blaetter (cdr v)))))
|
||||
)
|
||||
)
|
||||
|
||||
(defun lg-json-ebenen (s)
|
||||
(list 'ROH
|
||||
(strcat "["
|
||||
(ssg-join (mapcar '(lambda (e) (lg-json-obj (list (cons "schienenhoehe_mm" (car e))
|
||||
(cons "warenlaenge_mm" (cadr e)))))
|
||||
(lg-haengeebenen-parse s))
|
||||
", ")
|
||||
"]"))
|
||||
;; Zahl, null oder Array nur daraus (Punkte, Punktlisten, bbox).
|
||||
(defun lg-json-zahlen-p (v)
|
||||
(cond
|
||||
((or (null v) (numberp v)) T)
|
||||
((and (listp v) (eq (car v) 'ARR)) (vl-every 'lg-json-zahlen-p (cdr v)))
|
||||
(T nil)
|
||||
)
|
||||
)
|
||||
|
||||
;; Eingerueckter JSON-Text. Zahlenreihen (Punkte, Konturen) und kleine
|
||||
;; Container (bis *lg-json-inline-max* Blattwerte) bleiben einzeilig, alles
|
||||
;; andere bekommt je Eintrag eine Zeile.
|
||||
(setq *lg-json-inline-max* 12)
|
||||
|
||||
(defun lg-json-text (v einr / innen zeilen obj-p)
|
||||
(if (or (not (lg-json-container-p v))
|
||||
(lg-json-zahlen-p v)
|
||||
(<= (lg-json-blaetter v) *lg-json-inline-max*))
|
||||
(lg-json-wert v)
|
||||
(progn
|
||||
(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 (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 "}" "]"))
|
||||
(if obj-p "{}" "[]")))
|
||||
)
|
||||
)
|
||||
|
||||
;; --- Zugriff auf OBJ-Records ---
|
||||
(defun lg-j (obj key) (cdr (assoc key (cdr obj))))
|
||||
|
||||
(defun lg-j-setzen (obj key wert / alt)
|
||||
(if (setq alt (assoc key (cdr obj)))
|
||||
(cons 'OBJ (subst (cons key wert) alt (cdr obj)))
|
||||
(cons 'OBJ (append (cdr obj) (list (cons key wert)))))
|
||||
)
|
||||
|
||||
(defun lg-j-pkte (pts) (cons 'ARR (mapcar '(lambda (p) (cons 'ARR p)) pts)))
|
||||
(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))
|
||||
|
||||
(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)))
|
||||
)
|
||||
|
||||
;; Attributwert als Zahl bzw. Ganzzahl (nil, wenn leer).
|
||||
(defun lg-a-zahl (a tag) (lg-zahl (cdr (assoc tag a))))
|
||||
(defun lg-a-int (a tag / w) (if (setq w (lg-zahl (cdr (assoc tag a)))) (fix w)))
|
||||
|
||||
(defun lg-export-geschoss (g / a k pts bb)
|
||||
(setq a (caddr g) pts (cadddr g) bb (ssg-poly-bbox pts)
|
||||
k (lg-xdata-wert (car g) "kontur"))
|
||||
(lg-json-obj
|
||||
(list (cons "nr" (cadr g))
|
||||
(cons "bezeichnung" (cdr (assoc "BEZEICHNUNG" a)))
|
||||
(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"))
|
||||
(cons "belag_art" (cdr (assoc "BELAG_ART" a)))
|
||||
(cons "personen" (lg-a-int a "PERSONEN"))
|
||||
(cons "brandgefaehrdung" (cdr (assoc "BRANDGEFAEHRDUNG" a)))
|
||||
(cons "kontur_flaeche_mm2" (if pts (ssg-poly-flaeche pts)))
|
||||
(cons "kontur_umfang_mm" (if pts (ssg-poly-umfang pts)))
|
||||
(cons "kontur_bbox" (if bb (lg-json-zahlen (append (car bb) (cadr bb)))))
|
||||
(cons "handle" (lg-handle (car g)))
|
||||
(cons "kontur_handle" k)))
|
||||
;; Buehne = Belag vorhanden und kein Hallenboden. Rein.
|
||||
(defun lg-buehne-p (belag)
|
||||
(and (= (type belag) 'STR) (/= belag "") (/= (strcase belag T) "hallenboden"))
|
||||
)
|
||||
|
||||
(defun lg-export-bereich (e / a k pts bb)
|
||||
(setq a (ssg-attrib-read e)
|
||||
k (lg-ent-aus-handle (lg-xdata-wert e "kontur"))
|
||||
pts (if k (ssg-lwpoly-punkte k))
|
||||
bb (ssg-poly-bbox pts))
|
||||
(lg-json-obj
|
||||
(list (cons "nr" (lg-a-int a "NR"))
|
||||
(cons "geschoss" (lg-a-int a "GESCHOSS"))
|
||||
(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"))
|
||||
(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"))
|
||||
(cons "haengeebenen" (lg-json-ebenen (cdr (assoc "HAENGEEBENEN" a))))
|
||||
(cons "belag" (cdr (assoc "BELAG" a)))
|
||||
(cons "randgang_mm" (list 'ROH (lg-json-obj
|
||||
(mapcar '(lambda (r) (cons (strcase (car r) T) (cdr r)))
|
||||
(lg-bereich-rand a)))))
|
||||
(cons "restbreite_mm" (lg-a-zahl a "RESTBREITE_mm"))
|
||||
(cons "kontur_flaeche_mm2" (if pts (ssg-poly-flaeche pts)))
|
||||
(cons "kontur_bbox" (if bb (lg-json-zahlen (append (car bb) (cadr bb)))))
|
||||
(cons "handle" (lg-handle e))))
|
||||
;; --- Reine Kerne der Kennwerte (getestet) ---
|
||||
|
||||
;; Regallaenge je Haengeebene. reihen = Reihen-Records mit laenge_mm und
|
||||
;; haengeebenen; jede Reihe traegt ihre Laenge in jede ihrer Ebenen ein.
|
||||
;; Rueckgabe (ARR (OBJ schienenhoehe_mm warenlaenge_mm reihen regallaenge_mm)
|
||||
;; ...), nach Schienenhoehe absteigend.
|
||||
(defun lg-haengeebenen-summen (reihen / erg key alt l)
|
||||
(setq erg nil)
|
||||
(foreach r reihen
|
||||
(setq l (lg-n (lg-j r "laenge_mm")))
|
||||
(foreach e (cdr (lg-j r "haengeebenen"))
|
||||
(setq key (list (lg-n (lg-j e "schienenhoehe_mm")) (lg-n (lg-j e "warenlaenge_mm")))
|
||||
alt (assoc key erg))
|
||||
(setq erg (if alt
|
||||
(subst (list key (1+ (cadr alt)) (+ (caddr alt) l)) alt erg)
|
||||
(cons (list key 1 l) erg)))))
|
||||
(cons 'ARR
|
||||
(mapcar '(lambda (x) (list 'OBJ (cons "schienenhoehe_mm" (car (car x)))
|
||||
(cons "warenlaenge_mm" (cadr (car x)))
|
||||
(cons "reihen" (cadr x))
|
||||
(cons "regallaenge_mm" (caddr x))))
|
||||
(vl-sort erg '(lambda (a b) (if (equal (car (car a)) (car (car b)) 1e-6)
|
||||
(> (cadr (car a)) (cadr (car b)))
|
||||
(> (car (car a)) (car (car b))))))))
|
||||
)
|
||||
|
||||
(defun lg-export-linie (e art / a ed)
|
||||
(setq a (ssg-attrib-read e) ed (entget e))
|
||||
(lg-json-obj
|
||||
;; 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")))
|
||||
(foreach g gaenge
|
||||
(setq art (cond ((lg-j g "art")) ("unbekannt"))
|
||||
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))))))
|
||||
(cons 'OBJ
|
||||
(mapcar '(lambda (x) (cons (car x) (list 'OBJ (cons "anzahl" (cadr x))
|
||||
(cons "laenge_mm" (caddr x))
|
||||
(cons "flaeche_mm2" (cadddr x)))))
|
||||
erg))
|
||||
)
|
||||
|
||||
;; Die vier Kanten eines Rechtecks aus lg-linie-polygon, in fester
|
||||
;; Reihenfolge: 1-2 laengs, 2-3 stirn, 3-4 laengs, 4-1 stirn.
|
||||
(defun lg-rechteck-kanten (ecken)
|
||||
(list (list (nth 0 ecken) (nth 1 ecken)) (list (nth 1 ecken) (nth 2 ecken))
|
||||
(list (nth 2 ecken) (nth 3 ecken)) (list (nth 3 ecken) (nth 0 ecken)))
|
||||
)
|
||||
|
||||
(defun lg-bbox-beruehrt-p (a b tol)
|
||||
(and a b
|
||||
(<= (car (car b)) (+ (car (cadr a)) tol)) (<= (car (car a)) (+ (car (cadr b)) tol))
|
||||
(<= (cadr (car b)) (+ (cadr (cadr a)) tol)) (<= (cadr (car a)) (+ (cadr (cadr b)) tol)))
|
||||
)
|
||||
|
||||
;; Offener Teil der Kante (p q): Laenge minus die Abschnitte, auf denen eine
|
||||
;; Kante eines Nachbar-Rechtecks kollinear (Abstand < tol) aufliegt.
|
||||
(defun lg-kante-offen (kante nachbarn tol / p q len ux uy zu c d dx dy dl t1 t2 lo hi)
|
||||
(setq p (car kante) q (cadr kante) zu nil
|
||||
len (distance (list (car p) (cadr p)) (list (car q) (cadr q))))
|
||||
(if (< len 1e-9)
|
||||
0.0
|
||||
(progn
|
||||
(setq ux (/ (- (car q) (car p)) len) uy (/ (- (cadr q) (cadr p)) len))
|
||||
(foreach f nachbarn
|
||||
(foreach k (lg-rechteck-kanten f)
|
||||
(setq c (car k) d (cadr k)
|
||||
dx (- (car d) (car c)) dy (- (cadr d) (cadr c))
|
||||
dl (sqrt (+ (* dx dx) (* dy dy))))
|
||||
(if (and (> dl 1e-9)
|
||||
(< (abs (- (* ux dy) (* uy dx))) (* 1e-4 dl)) ; parallel
|
||||
(< (abs (- (* ux (- (cadr c) (cadr p))) (* uy (- (car c) (car p))))) tol)) ; gleiche Linie
|
||||
(progn
|
||||
(setq t1 (+ (* ux (- (car c) (car p))) (* uy (- (cadr c) (cadr p))))
|
||||
t2 (+ (* ux (- (car d) (car p))) (* uy (- (cadr d) (cadr p))))
|
||||
lo (max 0.0 (min t1 t2))
|
||||
hi (min len (max t1 t2)))
|
||||
(if (> (- hi lo) tol) (setq zu (cons (list lo hi) zu)))))))
|
||||
(apply '+ (cons 0.0 (mapcar '(lambda (i) (- (cadr i) (car i)))
|
||||
(ssg-intervalle-minus (list (list 0.0 len)) zu))))))
|
||||
)
|
||||
|
||||
;; Offene Kantenlaenge je Reihe. ecken-liste = je Reihe die 4 Ecken (2D)
|
||||
;; aus lg-linie-polygon. Eine Kante ist dort zu, wo eine Kante einer ANDEREN
|
||||
;; Reihe kollinear darauf liegt (z.B. Ruecken an Ruecken). Rueckgabe je
|
||||
;; Reihe (offen-laengs offen-stirn) in mm.
|
||||
(defun lg-reihen-offene-kanten (ecken-liste tol / bbs erg i j k bb nachbarn l s o)
|
||||
(setq bbs (mapcar 'ssg-poly-bbox ecken-liste) erg nil i 0)
|
||||
(foreach e ecken-liste
|
||||
(setq bb (nth i bbs) nachbarn nil j 0 l 0.0 s 0.0 k 0)
|
||||
(foreach f ecken-liste
|
||||
(if (and (/= i j) (lg-bbox-beruehrt-p bb (nth j bbs) tol))
|
||||
(setq nachbarn (cons f nachbarn)))
|
||||
(setq j (1+ j)))
|
||||
(foreach kante (lg-rechteck-kanten e)
|
||||
(setq o (lg-kante-offen kante nachbarn tol))
|
||||
(if (= 0 (rem k 2)) (setq l (+ l o)) (setq s (+ s o)))
|
||||
(setq k (1+ k)))
|
||||
(setq erg (cons (list l s) erg) i (1+ i)))
|
||||
(reverse erg)
|
||||
)
|
||||
|
||||
;; Gitterkorb der Reihen EINES Geschosses vervollstaendigen: Reihen mit
|
||||
;; gitterkorb (OBJ hoehe_mm) bekommen Boden (Laenge x Tiefe), offene Kanten
|
||||
;; (gegen alle Reihen des Geschosses) und Seitenflaeche (offen x Hoehe).
|
||||
(defun lg-reihen-gitterkorb-berechnen (reihen tol / offen)
|
||||
(if (vl-some '(lambda (r) (lg-j r "gitterkorb")) reihen)
|
||||
(progn
|
||||
(setq offen (lg-reihen-offene-kanten
|
||||
(mapcar '(lambda (r) (mapcar 'cdr (cdr (lg-j r "ecken")))) reihen) tol))
|
||||
(mapcar '(lambda (r o / gk h l b)
|
||||
(if (setq gk (lg-j r "gitterkorb"))
|
||||
(progn
|
||||
(setq h (lg-n (lg-j gk "hoehe_mm"))
|
||||
l (lg-n (lg-j r "laenge_mm"))
|
||||
b (lg-n (lg-j r "tiefe_mm")))
|
||||
(lg-j-setzen r "gitterkorb"
|
||||
(list 'OBJ (cons "hoehe_mm" (lg-j gk "hoehe_mm"))
|
||||
(cons "bodenflaeche_mm2" (* l b))
|
||||
(cons "offen_laengs_mm" (car o))
|
||||
(cons "offen_stirn_mm" (cadr o))
|
||||
(cons "seitenflaeche_mm2" (* h (+ (car o) (cadr o)))))))
|
||||
r))
|
||||
reihen offen))
|
||||
reihen)
|
||||
)
|
||||
|
||||
(defun lg-herkunft (key formel quelle)
|
||||
(cons key (list 'OBJ (cons "formel" formel) (cons "quelle" quelle)))
|
||||
)
|
||||
|
||||
;; 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.
|
||||
(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)
|
||||
(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)
|
||||
buehne (lg-buehne-p (lg-j g "belag_art"))
|
||||
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")
|
||||
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"))
|
||||
(lg-n (lg-j g "hoehe_belag_mm")))
|
||||
hk (cons (lg-herkunft "lichte_hoehe_mm"
|
||||
"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))
|
||||
)
|
||||
;; 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))
|
||||
(foreach r reihen
|
||||
(setq l (lg-n (lg-j r "laenge_mm"))
|
||||
f (* l (lg-n (lg-j r "tiefe_mm"))))
|
||||
(setq regal (+ regal l) grund (+ grund f)
|
||||
schienen (+ schienen (* l (if (numberp (lg-j r "schienen")) (lg-j r "schienen") 1))))
|
||||
(cond
|
||||
((equal (lg-j r "unter_reihe") "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")))))))
|
||||
)
|
||||
(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 "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))))
|
||||
hk))
|
||||
;; Belag und Gitterrost (nur Buehne)
|
||||
(setq belag-g 0.0 gitter-g 0.0)
|
||||
(foreach x gaenge
|
||||
(setq f (* (lg-n (lg-j x "laenge_mm")) (lg-n (lg-j x "breite_mm"))))
|
||||
(if (equal (lg-j x "belag") "gitterrost")
|
||||
(setq gitter-g (+ gitter-g f))
|
||||
(setq belag-g (+ belag-g f))))
|
||||
(if buehne
|
||||
(progn
|
||||
(if gaenge
|
||||
(setq belag belag-g
|
||||
hk (cons (lg-herkunft "belagsflaeche_mm2"
|
||||
"Summe LAENGE x BREITE_mm der Gaenge mit BELAG ungleich gitterrost"
|
||||
(strcat "LG_GANG_* Geschoss " nrs)) hk))
|
||||
(setq belag (- (lg-n (lg-j (lg-j g "kontur") "flaeche_mm2")) grund)
|
||||
hk (cons (lg-herkunft "belagsflaeche_mm2"
|
||||
"Konturflaeche - Grundflaeche der Regalreihen (keine LG_GANG-Flaechen)"
|
||||
(strcat "Belagskontur Geschoss " nrs)) hk)))
|
||||
(setq gitter (+ gitter-g gitter-r)
|
||||
hk (cons (lg-herkunft "gitterrostflaeche_mm2"
|
||||
(strcat "Summe LAENGE x BREITE_mm der Gaenge mit BELAG gitterrost"
|
||||
" + LAENGE x TIEFE_mm der Reihen mit UNTER_REIHE gitterrost")
|
||||
(strcat "LG_GANG_*/LG_REIHE_* Geschoss " nrs)) hk))
|
||||
(setq hk (cons (lg-herkunft "gitterkorb"
|
||||
(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 belag nil gitter nil
|
||||
hk (cons (lg-herkunft "buehne" "BELAG_ART hallenboden (oder leer): keine Buehne, kein Belag/Gitterrost/Gitterkorb" q) hk))
|
||||
)
|
||||
(list
|
||||
(list 'OBJ
|
||||
(cons "lichte_hoehe_mm" lichte)
|
||||
(cons "buehne" (if buehne T 'FALSE))
|
||||
(cons "bereiche" n-bereiche)
|
||||
(cons "reihen" (length reihen))
|
||||
(cons "regallaenge_mm" regal)
|
||||
(cons "regalgrundflaeche_mm2" grund)
|
||||
(cons "schienenlaenge_mm" schienen)
|
||||
(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 'OBJ (reverse hk)))
|
||||
)
|
||||
|
||||
(defun lg-summe-feld (objs key)
|
||||
(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)
|
||||
(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)))
|
||||
(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))))))
|
||||
)
|
||||
|
||||
;; --- Records aus der Zeichnung ---
|
||||
|
||||
(defun lg-ent-layer (e) (cdr (assoc 8 (entget e))))
|
||||
|
||||
(defun lg-export-kontur (k / pts)
|
||||
(if (and k (setq pts (ssg-lwpoly-punkte k)))
|
||||
(list 'OBJ
|
||||
(cons "handle" (lg-handle k))
|
||||
(cons "z" (cond ((caddr (car pts))) (0.0)))
|
||||
(cons "punkte" (lg-j-pkte (mapcar '(lambda (p) (list (car p) (cadr p))) pts)))
|
||||
(cons "flaeche_mm2" (ssg-poly-flaeche pts))
|
||||
(cons "umfang_mm" (ssg-poly-umfang pts))
|
||||
(cons "bbox" (lg-j-bbox (ssg-poly-bbox pts)))))
|
||||
)
|
||||
|
||||
(defun lg-export-geschoss-rec (g / a)
|
||||
(setq a (caddr g))
|
||||
(list 'OBJ
|
||||
(cons "nr" (cadr g))
|
||||
(cons "bezeichnung" (cdr (assoc "BEZEICHNUNG" a)))
|
||||
(cons "id" (cdr (assoc "ID" a)))
|
||||
(cons "handle" (lg-handle (car g)))
|
||||
(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"))
|
||||
(cons "belag_art" (cdr (assoc "BELAG_ART" a)))
|
||||
(cons "personen" (lg-a-int a "PERSONEN"))
|
||||
(cons "brandgefaehrdung" (cdr (assoc "BRANDGEFAEHRDUNG" a)))
|
||||
(cons "kontur" (lg-export-kontur (lg-ent-aus-handle (lg-xdata-wert (car g) "kontur"))))))
|
||||
|
||||
(defun lg-export-bereich-rec (e / a kinder)
|
||||
(setq a (ssg-attrib-read e) kinder (lg-bereich-kinder e))
|
||||
(list 'OBJ
|
||||
(cons "nr" (lg-a-int a "NR"))
|
||||
(cons "id" (cdr (assoc "ID" a)))
|
||||
(cons "handle" (lg-handle e))
|
||||
(cons "layer" (lg-ent-layer e))
|
||||
(cons "geschoss" (lg-a-int a "GESCHOSS"))
|
||||
(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"))
|
||||
(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"))
|
||||
(cons "haengeebenen" (lg-j-ebenen (cdr (assoc "HAENGEEBENEN" a))))
|
||||
(cons "belag" (cdr (assoc "BELAG" a)))
|
||||
(cons "unter_reihe" (lg-unter-reihe-wert (cdr (assoc "UNTER_REIHE" a)) (lg-unter-reihe-vorgabe) T))
|
||||
(cons "gitterkorb_hoehe_mm" (cond ((lg-a-zahl a "GITTERKORB_HOEHE_mm"))
|
||||
((lg-zahl (lg-vorgabe '("bereich" "gitterkorb_hoehe_mm") nil)))))
|
||||
(cons "randgang_mm" (cons 'OBJ (mapcar '(lambda (r) (cons (strcase (car r) T) (cdr r)))
|
||||
(lg-bereich-rand a))))
|
||||
(cons "restbreite_mm" (lg-a-zahl a "RESTBREITE_mm"))
|
||||
(cons "anzahl_reihen" (length (vl-remove-if-not '(lambda (k) (wcmatch (strcase (lg-blockname k)) "LG_REIHE_*")) kinder)))
|
||||
(cons "anzahl_gaenge" (length (vl-remove-if-not '(lambda (k) (wcmatch (strcase (lg-blockname k)) "LG_GANG_*")) kinder)))
|
||||
(cons "kontur" (lg-export-kontur (lg-ent-aus-handle (lg-xdata-wert e "kontur"))))))
|
||||
|
||||
;; 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)
|
||||
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")
|
||||
b (lg-a-zahl a (if (= art "reihe") "TIEFE_mm" "BREITE_mm"))
|
||||
p2 (polar (list (car p1) (cadr p1)) rot (lg-n l))
|
||||
quelle (cdr (assoc "QUELLE" a)))
|
||||
(if (member quelle '(nil "")) (setq quelle "auto"))
|
||||
(cons 'OBJ
|
||||
(append
|
||||
(list (cons "geschoss" (lg-a-int a "GESCHOSS"))
|
||||
(cons "laenge_mm" (lg-a-zahl a "LAENGE")))
|
||||
(list (cons "id" (cdr (assoc "ID" a)))
|
||||
(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"))
|
||||
(cons "quelle" quelle)
|
||||
(cons "laenge_mm" l))
|
||||
(if (= art "reihe")
|
||||
(list (cons "tiefe_mm" (lg-a-zahl a "TIEFE_mm"))
|
||||
(cons "haengeebenen" (lg-json-ebenen (cdr (assoc "HAENGEEBENEN" a))))
|
||||
(list (cons "tiefe_mm" b)
|
||||
(cons "schienen" (lg-a-int a "SCHIENEN"))
|
||||
(cons "quelle" (cdr (assoc "QUELLE" a))))
|
||||
(list (cons "breite_mm" (lg-a-zahl a "BREITE_mm"))
|
||||
(cons "haengeebenen" (lg-j-ebenen (cdr (assoc "HAENGEEBENEN" a)))))
|
||||
(list (cons "breite_mm" b)
|
||||
(cons "art" (cdr (assoc "ART" a)))
|
||||
(cons "belag" (cdr (assoc "BELAG" a)))
|
||||
(cons "quelle" (if (member (cdr (assoc "QUELLE" a)) '(nil "")) "auto"
|
||||
(cdr (assoc "QUELLE" a))))))
|
||||
(list (cons "bereich" (lg-a-int a "BEREICH"))
|
||||
(cons "start" (lg-json-zahlen (cdr (assoc 10 ed))))
|
||||
(cons "winkel_grad" (* (/ (cond ((cdr (assoc 50 ed))) (0.0)) pi) 180.0))
|
||||
(cons "handle" (lg-handle e)))))
|
||||
(cons "belag" (cdr (assoc "BELAG" a)))))
|
||||
(list (cons "start" (list 'ARR (car p1) (cadr p1) z))
|
||||
(cons "ende" (list 'ARR (car p2) (cadr p2) z))
|
||||
(cons "mitte" (list 'ARR (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0) z))
|
||||
(cons "winkel_grad" (* (/ rot pi) 180.0))
|
||||
(cons "ecken" (lg-j-pkte (lg-linie-polygon e)))
|
||||
(cons "flaeche_mm2" (* (lg-n l) (lg-n b))))))
|
||||
)
|
||||
|
||||
;; Alle Daten als JSON-Text.
|
||||
(defun lg-export-json ( / gs warn)
|
||||
(setq gs (lg-geschosse) warn nil)
|
||||
;; unter_reihe je Reihe aus ihrem Bereich (sonst Vorgabe), auf Hallenboden
|
||||
;; "keine"; Reihen mit Gitterkorb bekommen (OBJ hoehe_mm) als Startwert.
|
||||
(defun lg-reihen-unter-setzen (reihen bereiche geschosse vorgabe / br gr u)
|
||||
(mapcar
|
||||
'(lambda (r / br gr u)
|
||||
(setq br (if (lg-j r "bereich_handle")
|
||||
(vl-some '(lambda (b) (if (equal (lg-j b "handle") (lg-j r "bereich_handle")) b)) bereiche))
|
||||
gr (vl-some '(lambda (g) (if (equal (lg-j g "nr") (lg-j r "geschoss")) g)) geschosse)
|
||||
u (lg-unter-reihe-wert (lg-j br "unter_reihe") vorgabe (lg-buehne-p (lg-j gr "belag_art"))))
|
||||
(lg-j-setzen
|
||||
(lg-j-setzen r "unter_reihe" u)
|
||||
"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)))))))))
|
||||
reihen)
|
||||
)
|
||||
|
||||
;; 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)
|
||||
(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
|
||||
(if (null (cadddr g))
|
||||
(setq warn (cons (ssg-textf "lg-exp-geschoss-ohne-kontur" (list (itoa (cadr g)))) warn))))
|
||||
(strcat
|
||||
"{\n"
|
||||
" \"version\": 1,\n"
|
||||
" \"zeichnung\": " (lg-json-wert (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))) ",\n"
|
||||
" \"erzeugt\": " (lg-json-wert (ssg-timestamp)) ",\n"
|
||||
" \"einheit\": \"mm\",\n"
|
||||
" \"land\": " (lg-json-wert (lg-land)) ",\n"
|
||||
" \"belag_yaml\": " (lg-json-obj (vl-remove-if '(lambda (p) (or (/= (type (cdr p)) 'STR)
|
||||
(= (car p) "beschreibung")))
|
||||
(lg-vorgabe '("belag_yaml") nil))) ",\n"
|
||||
" \"reihen_als_gitterrost\": " (lg-json-wert (if (lg-vorgabe '("flaechen" "reihen_als_gitterrost") nil) T nil)) ",\n"
|
||||
" \"geschosse\": " (lg-json-arr (mapcar 'lg-export-geschoss gs) " ") ",\n"
|
||||
" \"bereiche\": " (lg-json-arr (mapcar 'lg-export-bereich (lg-alle-bloecke "LG_BEREICH")) " ") ",\n"
|
||||
" \"reihen\": " (lg-json-arr (mapcar '(lambda (e) (lg-export-linie e "reihe")) (lg-alle-bloecke "LG_REIHE_*")) " ") ",\n"
|
||||
" \"gaenge\": " (lg-json-arr (mapcar '(lambda (e) (lg-export-linie e "gang")) (lg-alle-bloecke "LG_GANG_*")) " ") ",\n"
|
||||
" \"warnungen\": " (lg-json-arr (mapcar 'lg-json-wert warn) " ") "\n"
|
||||
"}\n")
|
||||
(setq bereiche (mapcar 'lg-export-bereich-rec (lg-alle-bloecke "LG_BEREICH"))
|
||||
reihen (mapcar '(lambda (e) (lg-export-linie-rec e "reihe")) (lg-alle-bloecke "LG_REIHE_*"))
|
||||
gaenge (mapcar '(lambda (e) (lg-export-linie-rec e "gang")) (lg-alle-bloecke "LG_GANG_*"))
|
||||
;; Geschosse von unten nach oben (Belagshoehe, dann Nr)
|
||||
g-recs (vl-sort (mapcar 'lg-export-geschoss-rec gs)
|
||||
'(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 g-neu nil r-neu nil r-gs nil g-gs nil i 0)
|
||||
(foreach g g-recs
|
||||
(setq nr (lg-j g "nr")
|
||||
nx (nth (1+ i) g-recs)
|
||||
r-gs (lg-reihen-gitterkorb-berechnen
|
||||
(vl-remove-if-not '(lambda (r) (equal (lg-j r "geschoss") nr)) reihen) 1.0)
|
||||
g-gs (vl-remove-if-not '(lambda (x) (equal (lg-j x "geschoss") nr)) gaenge)
|
||||
kw (lg-kennwerte-geschoss g nx r-gs g-gs
|
||||
(length (vl-remove-if-not '(lambda (b) (equal (lg-j b "geschoss") nr)) bereiche))))
|
||||
(if (null (lg-j (car kw) "lichte_hoehe_mm"))
|
||||
(setq warn (cons (ssg-textf "lg-exp-lichte-hoehe-oben" (list (itoa nr))) warn)))
|
||||
(if (not (lg-buehne-p (lg-j g "belag_art")))
|
||||
(foreach b bereiche
|
||||
(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)))))
|
||||
(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)))
|
||||
(setq g-neu (reverse g-neu)
|
||||
nrs (mapcar '(lambda (g) (lg-j g "nr")) g-recs)
|
||||
r-gs (vl-remove-if '(lambda (r) (member (lg-j r "geschoss") nrs)) reihen))
|
||||
(if r-gs
|
||||
(setq warn (cons (ssg-textf "lg-exp-reihen-ohne-geschoss" (list (itoa (length r-gs)))) warn)))
|
||||
(list 'OBJ
|
||||
(cons "format" "ssg-lager")
|
||||
(cons "version" 2)
|
||||
(cons "zeichnung" (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
|
||||
(cons "erzeugt" (ssg-timestamp))
|
||||
(cons "land" (lg-land))
|
||||
(cons "einheiten" (list 'OBJ (cons "laenge" "mm") (cons "flaeche" "mm2") (cons "winkel" "grad")))
|
||||
(cons "koordinaten" "WCS, Nord = +Y")
|
||||
(cons "lager" (lg-kennwerte-lager g-neu r-neu
|
||||
(vl-remove-if-not '(lambda (x) (member (lg-j x "geschoss") nrs)) gaenge)
|
||||
(length bereiche)))
|
||||
(cons "geschosse" (cons 'ARR g-neu))
|
||||
(cons "bereiche" (cons 'ARR bereiche))
|
||||
(cons "reihen" (cons 'ARR (append r-neu r-gs)))
|
||||
(cons "gaenge" (cons 'ARR gaenge))
|
||||
(cons "warnungen" (cons 'ARR (reverse warn))))
|
||||
)
|
||||
|
||||
;; Alle Daten als JSON-Text.
|
||||
(defun lg-export-json ( / )
|
||||
(strcat (lg-json-text (lg-export-daten) "") "\n")
|
||||
)
|
||||
|
||||
(defun lg-ausgabe-verzeichnis ( / d)
|
||||
@@ -2180,49 +2641,11 @@
|
||||
(progn (princ (ssg-textf "lg-exp-datei-fehler" (list pfad))) nil))
|
||||
)
|
||||
|
||||
;; Python-Skript lager_yaml_export.py aufrufen (nutzt die Interpreter-
|
||||
;; Ermittlung aus export.lsp). Rueckgabe: Exitcode oder nil.
|
||||
(defun lg-python-aufrufen (raw yaml html / skript hand log args rc)
|
||||
(cond
|
||||
((not (car (atoms-family 1 '("EXPORT:RUN-PYTHON"))))
|
||||
(princ (ssg-text "lg-exp-ohne-python")) nil)
|
||||
((null (getenv "DXFM_LIB")) (princ (ssg-text "lg-exp-ohne-python")) nil)
|
||||
(T
|
||||
(setq skript (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LIB")) "/lager_yaml_export.py")
|
||||
hand (lg-ldata-lesen "HAND_YAML")
|
||||
log (strcat (lg-ausgabe-verzeichnis) "/lager_export_python.log"))
|
||||
(setq args (list raw yaml "--nachweis" html))
|
||||
(if (and hand (= (type hand) 'STR) (findfile hand))
|
||||
(setq args (append args (list "--hand" hand))))
|
||||
(setq rc (export:run-python (export:python-exe) skript args log))
|
||||
(if (and rc (/= rc 0))
|
||||
(princ (ssg-textf "lg-exp-python-fehler" (list (vl-princ-to-string rc) log))))
|
||||
rc)
|
||||
)
|
||||
)
|
||||
|
||||
(defun c:LAGER_EXPORT ( / dir basis raw yaml html rc)
|
||||
(setq dir (lg-ausgabe-verzeichnis) basis (lg-dwg-basis))
|
||||
(setq raw (strcat dir "/" basis "_lager_raw.json")
|
||||
yaml (strcat dir "/" basis "_drawing.yaml")
|
||||
html (strcat dir "/" basis "_nachweis.html"))
|
||||
(if (lg-export-schreiben raw)
|
||||
(progn
|
||||
(princ (ssg-textf "lg-exp-raw" (list raw)))
|
||||
(setq rc (lg-python-aufrufen raw yaml html))
|
||||
(if (and rc (= rc 0))
|
||||
(princ (ssg-textf "lg-exp-yaml" (list yaml html))))))
|
||||
(princ)
|
||||
)
|
||||
|
||||
;; Hand-YAML fuer den Abgleich (Konfliktliste) festlegen; leer = keiner.
|
||||
(defun c:LAGER_HAND_YAML ( / alt neu)
|
||||
(setq alt (lg-ldata-lesen "HAND_YAML"))
|
||||
(setq neu (if (ssg-gui-p)
|
||||
(getfiled (ssg-text "lg-titel-hand-yaml") (if (= (type alt) 'STR) alt "") "yaml" 0)
|
||||
(ssg-in-string (ssg-text "lg-titel-hand-yaml") (if (= (type alt) 'STR) alt ""))))
|
||||
(lg-ldata-setzen "HAND_YAML" (if neu neu ""))
|
||||
(princ (ssg-textf "lg-hand-yaml" (list (if (and neu (/= neu "")) neu "-"))))
|
||||
;; Technische Daten des Lagers als <dwg>_lager.json nach DXFM_RESULTS.
|
||||
(defun c:LAGER_EXPORT ( / pfad)
|
||||
(setq pfad (strcat (lg-ausgabe-verzeichnis) "/" (lg-dwg-basis) "_lager.json"))
|
||||
(if (lg-export-schreiben pfad)
|
||||
(princ (ssg-textf "lg-exp-json" (list pfad))))
|
||||
(princ)
|
||||
)
|
||||
|
||||
|
||||
Reference in new issue
Block a user