[ADD] Gerüst Dummydateien sowie Zeichnungsdateien hinzugefügt; [FIX] Anzahl und menge der Baugruppenteile unterscheidet sich nun mit dem vorgabe wert für die Inputfelder; [CHANGE] Gerüstträger in separates JSON FIle ausgelagert, da andere Einfügelogik

This commit is contained in:
2026-10-05 09:49:20 +02:00
parent 6ec85905d4
commit fe5cb9664c
14 changed files with 488 additions and 348 deletions
+125 -72
View File
@@ -5,6 +5,7 @@
;; Nutzer eine Basis-Variante, Anbauteile fuer "Befestigung oben" UND
;; "Befestigung unten" (je mit eigener Stueckzahl), Laenge und Farbe waehlen,
;; und fuegt das Ergebnis als Block GR_<id>_<Zeitstempel> ein.
;; Rohr-Geruest-Traeger (GERUEST_TRAEGER) lesen data/json/geruest_traeger.json.
;;
;; Beide Befestigungslisten enthalten ALLE Anbauteile der Baugruppe - dasselbe
;; Teil kann oben, unten oder gleichzeitig an beiden Positionen sitzen.
@@ -100,9 +101,10 @@
)
)
(defun geruest-json-pfad ( / basis)
;; Pfad einer Datendatei unter data/json, z.B. "geruest.json".
(defun geruest-json-pfad (datei / basis)
(if (setq basis (geruest-data-verzeichnis))
(strcat basis "/json/geruest.json")
(strcat basis "/json/" datei)
)
)
@@ -112,36 +114,48 @@
)
)
;; Datendatei einmal je Zeichnungssitzung laden.
(defun geruest-daten ( / pfad)
(if (null *geruest-daten*)
;; Datendatei unter data/json einmal je Zeichnungssitzung laden und im
;; globalen Symbol cache-sym ablegen. Rueckgabe: die geparsten Daten oder nil
;; (mit Meldung).
(defun geruest-json-laden-cache (datei cache-sym / pfad daten)
(if (null (eval cache-sym))
(progn
(setq pfad (geruest-json-pfad))
(setq pfad (geruest-json-pfad datei))
(cond
((null pfad) (princ (ssg-text "gr-fehler-datenpfad")))
((null (findfile pfad)) (princ (ssg-textf "gr-fehler-json-fehlt" (list pfad))))
(T
(setq *geruest-daten* (ssg-json-laden pfad))
(if (null *geruest-daten*)
(setq daten (ssg-json-laden pfad))
(set cache-sym daten)
(if (null daten)
(princ (ssg-textf "gr-fehler-json-lesbar" (list pfad)))
)
)
)
)
)
*geruest-daten*
(eval cache-sym)
)
;; Baugruppen des GERUEST-Dialogs (Rohrabhaenger, Saeulen, Wandbefestigung).
(defun geruest-daten ( / )
(geruest-json-laden-cache "geruest.json" '*geruest-daten*)
)
;; Traeger-Baugruppen mit Linien-Logik (Rohr-Geruest-Traeger, spaeter z.B.
;; Gattertraeger) - bewusst eine eigene Datei: eigener Dialog, Laenge aus der
;; Zeichnung, Streben/Muffe/Beschriftung statt Anbaugruppen/Konfigurationen.
(defun geruest-traeger-daten ( / )
(geruest-json-laden-cache "geruest_traeger.json" '*geruest-traeger-daten*)
)
;; Alle Baugruppen als ((id . objekt) ...) in Dateireihenfolge - diese
;; Reihenfolge bestimmt auch die Reihenfolge im Bereichs-Dropdown.
;; Baugruppen mit "einfuegeart": "linie" (Rohr-Geruest-Traeger) fehlen hier:
;; sie haben einen eigenen Dialog und einen eigenen Einfuegeablauf
;; (c:GERUEST_TRAEGER) und gehoeren nicht in das Bereichs-Dropdown.
;; Reihenfolge bestimmt auch die Reihenfolge im Bereichs-Dropdown. Die
;; Traeger stehen in geruest_traeger.json und gehoeren nicht hierher.
(defun geruest-baugruppen-liste ( / erg)
(setq erg nil)
(foreach eintrag (geruest-daten)
(if (and (listp (cdr eintrag))
(not (equal (ssg-json-get (cdr eintrag) "einfuegeart") "linie")))
(if (listp (cdr eintrag))
(setq erg (append erg
(list (cons (ssg-json-get (cdr eintrag) "id") (cdr eintrag)))))
)
@@ -169,6 +183,40 @@
(if (and w (/= w "")) w (ssg-json-get bg schluessel))
)
;; Pfad der Dummy-DWG fuer den Block. Ein "dummy" in der Geometrie-Variante
;; wird bevorzugt; fehlt die Datei unter data/geruest, wird gemeldet und auf
;; den "dummy" der Baugruppe zurueckgefallen. Rueckgabe: (datei . pfad) -
;; pfad ist nil, wenn kein Datenverzeichnis bekannt ist; ob die
;; Rueckfall-Datei existiert, prueft der Aufrufer.
(defun geruest-dummy-wahl (variante bg / v pfad)
(setq v (if variante (ssg-json-get variante "dummy")))
(if (and v (= (type v) 'STR) (/= v "")
(setq pfad (geruest-dummy-pfad v))
(findfile pfad))
(cons v pfad)
(progn
(if (and v (= (type v) 'STR) (/= v ""))
(princ (ssg-textf "gr-fehler-dummy-variante"
(list (if pfad pfad v)
(if (ssg-json-get bg "dummy")
(ssg-json-get bg "dummy")
"-"))))
)
(setq v (ssg-json-get bg "dummy"))
(cons v (geruest-dummy-pfad v))
)
)
)
;; Liste ohne die Eintraege, die (ohne Gross/Klein) gleich pfad sind. Damit
;; landet eine Teile-DWG, die zugleich der Dummy ist, nicht doppelt im Block.
(defun geruest-ohne-pfad (pfad liste)
(if pfad
(vl-remove-if '(lambda (p) (= (strcase p) (strcase pfad))) liste)
liste
)
)
;; ============================================================
;; TEILE AUSWERTEN
@@ -184,9 +232,23 @@
)
)
(defun geruest-menge (eintrag / m)
(setq m (ssg-json-get eintrag "menge"))
(if (and m (numberp m) (> m 0)) (fix m) 1)
;; Zwei Mengenfelder im JSON, bewusst verschieden benannt:
;; "stueckzahl" = wie oft das Teil TATSAECHLICH geschrieben wird - je
;; Einbau (Variante) bzw. je Satz/Anbauteil. Fehlt = 1.
;; "anzahl_vorgabe" = NUR die Vorbelegung des Anzahl-Feldes im Dialog
;; (Anbaugruppen). Fehlt = 1.
;; Ein Anbauteil wird Anzahl (Dialog) x stueckzahl mal geschrieben; bei einer
;; Gruppe ("teile") ist die Anzahl die Zahl der Saetze.
(defun geruest-positiv-int (w / )
(if (and w (numberp w) (> w 0)) (fix w) 1)
)
(defun geruest-stueckzahl (eintrag)
(geruest-positiv-int (ssg-json-get eintrag "stueckzahl"))
)
(defun geruest-anzahl-vorgabe (eintrag)
(geruest-positiv-int (ssg-json-get eintrag "anzahl_vorgabe"))
)
;; Sivas-ID als String. Im JSON stehen rein numerische IDs als Zahl
@@ -212,7 +274,7 @@
)
;; Alle Teile eines Eintrags als ((artnr . farbig) ...), jedes gemaess
;; "menge" wiederholt. Benannte Gruppen ("teile") werden rekursiv aufgeloest.
;; "stueckzahl" wiederholt. Benannte Gruppen ("teile") werden rekursiv aufgeloest.
;; farbig = darf das Teil die Baugruppenfarbe tragen ("farbig" im JSON). Eine
;; Gruppe mit "farbig": true vererbt das an ihre Teile (erbe); ein Teil kann
;; die Vererbung nicht per false aufheben - false und "fehlt" sind beide nil.
@@ -229,12 +291,12 @@
(setq erg (mapcar '(lambda (nr) (cons nr farbig))
(geruest-wiederholen
(geruest-id-string (ssg-json-get eintrag "sivas_id"))
(geruest-menge eintrag))))
(geruest-stueckzahl eintrag))))
)
erg
)
;; Alle Artikelnummern eines Eintrags, jede gemaess "menge" wiederholt.
;; Alle Artikelnummern eines Eintrags, jede gemaess "stueckzahl" wiederholt.
(defun geruest-artikelnummern (eintrag)
(mapcar 'car (geruest-teile-paare eintrag nil))
)
@@ -289,7 +351,7 @@
;; Eingabe aus einem Mengenfeld auswerten.
;; Leer -> Vorgabewert aus dem JSON, gueltig -> Zahl >= 1, sonst nil.
(defun geruest-menge-wert (s vorgabe)
(defun geruest-anzahl-wert (s vorgabe)
(setq s (ssg-cfg-trim (if s s "")))
(cond
((= s "") vorgabe)
@@ -310,30 +372,18 @@
)
)
;; Artikelnummern eines Eintrags bei frei gewaehlter Stueckzahl.
;; Einzelteil: die Sivas-ID anzahl-mal. Benannte Gruppe ("teile"): das
;; komplette Set anzahl-mal - die Mengen INNERHALB des Sets bleiben erhalten
;; Teile eines Anbauteils bei der im Dialog gewaehlten Anzahl: der Eintrag
;; (Einzelteil mit seiner "stueckzahl" bzw. benannte Gruppe als kompletter
;; Satz) anzahl-mal. Die Stueckzahlen INNERHALB eines Satzes bleiben erhalten
;; (ein Schraubenset bleibt 1 Scheibe + 2 Muttern + 1 Schraube je Satz).
(defun geruest-teile-paare-n (eintrag anzahl / teile einmal erg i farbig)
(setq teile (ssg-json-get eintrag "teile"))
(setq farbig (if (ssg-json-get eintrag "farbig") T nil))
(if teile
(progn
(setq einmal nil)
(foreach teil teile
(setq einmal (append einmal (geruest-teile-paare teil farbig)))
)
(setq erg nil i 0)
(while (< i anzahl)
(setq erg (append erg einmal))
(setq i (1+ i))
)
erg
)
(mapcar '(lambda (nr) (cons nr farbig))
(geruest-wiederholen
(geruest-id-string (ssg-json-get eintrag "sivas_id")) anzahl))
(defun geruest-teile-paare-n (eintrag anzahl / einmal erg i)
(setq einmal (geruest-teile-paare eintrag nil))
(setq erg nil i 0)
(while (< i anzahl)
(setq erg (append erg einmal))
(setq i (1+ i))
)
erg
)
(defun geruest-artikelnummern-n (eintrag anzahl)
@@ -441,7 +491,7 @@
;; Positionsliste ("oben"/"unten") einer Konfiguration auf die Anbauteile
;; abbilden. Rueckgabe: ein Eintrag je Anbauteil - nil (nicht gewaehlt) oder
;; die Stueckzahl. Ein unbekannter Artikelname wird gemeldet und
;; die Anzahl (Feld "anzahl"). Ein unbekannter Artikelname wird gemeldet und
;; uebersprungen, statt die ganze Konfiguration scheitern zu lassen.
(defun geruest-konfig-position (konfig schluessel anbauteile / mengen idx n)
(setq mengen (geruest-nil-liste (length anbauteile)))
@@ -449,7 +499,7 @@
(setq idx (geruest-name-index (ssg-json-get e "artikel") anbauteile))
(if idx
(progn
(setq n (ssg-json-get e "menge"))
(setq n (ssg-json-get e "anzahl"))
(setq mengen (geruest-liste-setzen mengen idx
(if (and n (numberp n) (> n 0)) (fix n) 1)))
)
@@ -583,20 +633,20 @@
(defun geruest-dlg-standard ( / erg)
(setq erg nil)
(foreach a *geruest-anbauteile*
(setq erg (append erg (list (cons "0" (itoa (geruest-menge a))))))
(setq erg (append erg (list (cons "0" (itoa (geruest-anzahl-vorgabe a))))))
)
erg
)
;; Mengenliste (nil oder Zahl je Teil) in den Tile-Zustand umsetzen.
(defun geruest-mengen->tiles (mengen / erg i a)
(defun geruest-anzahlen->tiles (mengen / erg i a)
(setq erg nil i 0)
(foreach m mengen
(setq a (nth i *geruest-anbauteile*))
(setq erg (append erg
(list (if m
(cons "1" (itoa m))
(cons "0" (itoa (geruest-menge a)))))))
(cons "0" (itoa (geruest-anzahl-vorgabe a)))))))
(setq i (1+ i))
)
erg
@@ -720,10 +770,10 @@
*geruest-dlg-frei* farbe))
)
(setq *geruest-dlg-oben*
(geruest-mengen->tiles
(geruest-anzahlen->tiles
(geruest-konfig-position k "oben" *geruest-anbauteile*)))
(setq *geruest-dlg-unten*
(geruest-mengen->tiles
(geruest-anzahlen->tiles
(geruest-konfig-position k "unten" *geruest-anbauteile*)))
)
)
@@ -745,16 +795,16 @@
)
;; Angehakte Teile einer Spalte mit gueltiger Menge einsammeln.
;; Rueckgabe: (T . ((index . menge) ...)) oder nil bei ungueltigem Mengenfeld.
;; Rueckgabe: (T . ((index . anzahl) ...)) oder nil bei ungueltigem Mengenfeld.
;; Das fuehrende T ist noetig, weil "nichts ausgewaehlt" ein gueltiges
;; Ergebnis ist und sich sonst nicht von einem Fehler unterscheiden liesse.
(defun geruest-mengen-lesen (zustand / erg i a m ok)
(defun geruest-anzahlen-lesen (zustand / erg i a m ok)
(setq erg nil i 0 ok T)
(foreach paar zustand
(setq a (nth i *geruest-anbauteile*))
(if (and ok (= (car paar) "1"))
(progn
(setq m (geruest-menge-wert (cdr paar) (geruest-menge a)))
(setq m (geruest-anzahl-wert (cdr paar) (geruest-anzahl-vorgabe a)))
(if m
(setq erg (append erg (list (cons i m))))
(setq ok nil)
@@ -788,11 +838,11 @@
(setq a (nth i *geruest-anbauteile*))
(if (= (car paar) "1")
(progn
(setq m (geruest-menge-wert (cdr paar) (geruest-menge a)))
(setq m (geruest-anzahl-wert (cdr paar) (geruest-anzahl-vorgabe a)))
(if m
(setq erg (append erg
(list (list (cons "artikel" (geruest-eintrag-name a))
(cons "menge" m)))))
(cons "anzahl" m)))))
)
)
)
@@ -818,7 +868,7 @@
(write-line
(strcat " { \"artikel\": \""
(ssg-json-escape (ssg-json-get e "artikel"))
"\", \"menge\": " (itoa (ssg-json-get e "menge")) " }"
"\", \"anzahl\": " (itoa (ssg-json-get e "anzahl")) " }"
(if (< i n) "," ""))
f)
)
@@ -963,7 +1013,7 @@
)
;; Dialog fuer einen Bereich zeigen. Rueckgabe:
;; ("OK" variante-index ((idx . menge) ...) ((idx . menge) ...) laenge farbe)
;; ("OK" variante-index ((idx . anzahl) ...) ((idx . anzahl) ...) laenge farbe)
;; - drittes Element = Befestigung oben, viertes = unten
;; ("WECHSEL" bereich-index) - Nutzer hat den Bereich umgestellt
;; nil - abgebrochen
@@ -1120,8 +1170,8 @@
)
(T
(setq oben-m (geruest-mengen-lesen *geruest-dlg-oben*))
(setq unten-m (geruest-mengen-lesen *geruest-dlg-unten*))
(setq oben-m (geruest-anzahlen-lesen *geruest-dlg-oben*))
(setq unten-m (geruest-anzahlen-lesen *geruest-dlg-unten*))
(if (or (null oben-m) (null unten-m))
(alert (ssg-text "gr-alert-menge"))
(progn
@@ -1170,10 +1220,14 @@
;; Rueckgabe: (blockname . entity) oder nil.
(defun geruest-block-bauen (bg variante werte pt teile-dwgs / datei dummy lastEnt dummyEnt
dummy-attribs attribs)
;; Eine Variante darf eine eigene Dummy-DWG mitbringen; sonst gilt die der
;; Baugruppe.
(setq datei (geruest-variante-wert variante bg "dummy"))
(setq dummy (geruest-dummy-pfad datei))
;; Eine Variante darf eine eigene Dummy-DWG mitbringen; sonst (oder wenn
;; deren Datei fehlt) gilt die der Baugruppe.
(setq datei (geruest-dummy-wahl variante bg))
(setq dummy (cdr datei)
datei (car datei))
;; Ist der Dummy zugleich eine Teile-DWG (z.B. 821006036.dwg beim
;; T-Abhaenger), nicht ein zweites Mal einfuegen.
(setq teile-dwgs (geruest-ohne-pfad dummy teile-dwgs))
(if (or (null dummy) (null (findfile dummy)))
(progn
(princ (ssg-textf "gr-fehler-dummy" (list (if dummy dummy datei))))
@@ -1269,7 +1323,7 @@
;; ============================================================
;; Teile-Paare ((artnr . farbig) ...) einer Befestigungsauswahl
;; ((index . menge) ...).
;; ((index . anzahl) ...).
(defun geruest-auswahl-paare (auswahl anbauteile / erg)
(setq erg nil)
(foreach paar auswahl
@@ -1410,7 +1464,7 @@
;; ============================================================
;; ROHR-GERUEST-TRAEGER (Baugruppe mit "einfuegeart": "linie")
;; ROHR-GERUEST-TRAEGER (Daten: data/json/geruest_traeger.json)
;; ============================================================
;; Eigener Dialog (dcl/geruest_traeger.dcl): Variante, Farbe und zwei
;; Laengenabzuege. Die Laenge selbst wird DANACH in der Zeichnung bestimmt -
@@ -1425,11 +1479,10 @@
;; Richtungswinkel eingefuegt. Es wird wiederholt eingefuegt, bis der Nutzer
;; ESC/Enter drueckt - jeder Traeger ist ein eigener GR_Traeger_<ts>-Block.
;; Baugruppe ueber das ASCII-Feld "id" (auch solche, die
;; geruest-baugruppen-liste auslaesst).
(defun geruest-baugruppe (id / erg)
;; Baugruppe ueber das ASCII-Feld "id" in daten (z.B. (geruest-traeger-daten)).
(defun geruest-baugruppe (id daten / erg)
(setq erg nil)
(foreach eintrag (geruest-daten)
(foreach eintrag daten
(if (and (null erg) (listp (cdr eintrag))
(equal (ssg-json-get (cdr eintrag) "id") id))
(setq erg (cdr eintrag))
@@ -2098,7 +2151,7 @@
cfg laenge lage lay handle code erg)
(setq ed (entget blockEnt))
(setq attribs (ssg-attrib-read blockEnt))
(setq bg (geruest-baugruppe "Traeger"))
(setq bg (geruest-baugruppe "Traeger" (geruest-traeger-daten)))
(setq laenge (atof (cond ((cdr (assoc "LAENGE" attribs))) ("0"))))
(if (and bg (> laenge 0.0))
(progn
@@ -2190,7 +2243,7 @@
)
(defun c:GERUEST_TRAEGER ( / bg wahl)
(setq bg (geruest-baugruppe "Traeger"))
(setq bg (geruest-baugruppe "Traeger" (geruest-traeger-daten)))
(cond
((null bg)
(princ (ssg-textf "gr-fehler-baugruppe" (list "Traeger"))))