dxfmakros/Lisp/GeruestInsert.lsp

;; ============================================================
;; GeruestInsert.lsp - Geruest-Baugruppen konfigurieren und einfuegen
;;
;; Liest data/json/geruest.json (rekursiv per ssg-json-laden), laesst den
;; 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.
;;
;; Beide Befestigungslisten enthalten ALLE Anbauteile der Baugruppe - dasselbe
;; Teil kann oben, unten oder gleichzeitig an beiden Positionen sitzen.
;;
;; Die Dialogdefinition wird zur Laufzeit erzeugt (geruest-dcl-schreiben):
;; eine DCL-Liste kann keine Eingabefelder enthalten, ein Mengenfeld je Teil
;; ist also nur mit generierten Zeilen moeglich.
;;
;; Konfigurationen kommen aus zwei getrennten Quellen: der gepflegten
;; Bibliothek in geruest.json und den eigenen in cfg/geruest_user.json.
;;
;; Der Block wird - wie KREISEL_n/VF_n - selbst zusammengebaut: die Dummy-DWG
;; aus data/geruest liefert nur die Geometrie, das Attribut-Schema kommt aus
;; *geruest-attrib-defs*. Damit kann kein Attribut still verlorengehen, wenn
;; die Dummy-DWG einen Tag nicht kennt (ssg-attrib-set-on schreibt nur Tags,
;; die als ATTDEF existieren).
;;
;; Das GR_-Praefix ist nicht kosmetisch: SSG_BLOCKEDIT haelt jeden Block mit
;; TEILEART-Attribut fuer ein Omniflo-Element (SSG_LIB_Commands.lsp). Der
;; Doppelklick-Dispatcher erkennt Geruest-Bloecke an diesem Praefix.
;;
;; Alle Bereiche liegen in EINEM Dialog; oben wird per Dropdown zwischen
;; Rohrabhaenger, Saeulen und Wandbefestigung umgeschaltet. DCL hat kein
;; Reiter-Tile, und da sich die Teilezeilen je Bereich unterscheiden, wird der
;; Dialog beim Wechsel geschlossen und neu aufgebaut - der Stand jedes
;; Bereichs bleibt dabei in *geruest-zustand* erhalten.
;;
;; Befehl: GERUEST
;; ============================================================

(vl-load-com)

;; Attribut-Schema des Wrapper-Blocks. Die Dummy-DWG darf eigene Tags
;; mitbringen - die bleiben erhalten (ssg-attrib-merge).
;; "ID" (leer vorbelegt, wie bei Kreisel/VF_n/GF_n) ist Voraussetzung dafuer,
;; dass ssg-id-check-all dem Block ueberhaupt eine ID zuweisen kann -
;; ssg-attrib-set-on schreibt nur auf ein bereits vorhandenes ATTDEF, siehe
;; oben. Ohne diesen Eintrag bliebe ID fuer immer leer (csv:read-attribs
;; exportiert dann eben kein "ID"-Feld statt eines Werts).
(if (null *geruest-attrib-defs*)
  (setq *geruest-attrib-defs*
    '(("ID"          "")
      ("ARTINR"      "")
      ("LAENGE"      "")
      ("BEZEICHNUNG" "")
      ("TEILEART"    "")
      ("TEILEFARBE"  "")
      ("LAYER"       "")
    )
  )
)

(if (null *geruest-block-counter*) (setq *geruest-block-counter* 0))


;; ============================================================
;; DATEN
;; ============================================================

(defun geruest-data-verzeichnis ( / )
  (cond
    ((getenv "DXFM_DATA") (vl-string-translate "\\" "/" (getenv "DXFM_DATA")))
    ((getenv "DXFMAKRO")
      (strcat (vl-string-translate "\\" "/" (getenv "DXFMAKRO")) "/data"))
  )
)

(defun geruest-json-pfad ( / basis)
  (if (setq basis (geruest-data-verzeichnis))
    (strcat basis "/json/geruest.json")
  )
)

(defun geruest-dummy-pfad (datei / basis)
  (if (and datei (setq basis (geruest-data-verzeichnis)))
    (strcat basis "/geruest/" datei)
  )
)

;; Datendatei einmal je Zeichnungssitzung laden.
(defun geruest-daten ( / pfad)
  (if (null *geruest-daten*)
    (progn
      (setq pfad (geruest-json-pfad))
      (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*)
            (princ (ssg-textf "gr-fehler-json-lesbar" (list pfad)))
          )
        )
      )
    )
  )
  *geruest-daten*
)

;; Alle Baugruppen als ((id . objekt) ...) in Dateireihenfolge - diese
;; Reihenfolge bestimmt auch die Reihenfolge im Bereichs-Dropdown.
(defun geruest-baugruppen-liste ( / erg)
  (setq erg nil)
  (foreach eintrag (geruest-daten)
    (if (listp (cdr eintrag))
      (setq erg (append erg
                  (list (cons (ssg-json-get (cdr eintrag) "id") (cdr eintrag)))))
    )
  )
  erg
)

;; Anzeigename einer Baugruppe fuer Dropdown und Kopfzeile. Bewusst das
;; ASCII-Feld "titel" und nicht der aeussere JSON-Schluessel - der traegt
;; Umlaute ("Rohrabhänger", "Säulen").
(defun geruest-titel (bg / t1)
  (setq t1 (ssg-json-get bg "titel"))
  (if (and t1 (= (type t1) 'STR) (/= t1 ""))
    t1
    (ssg-json-get bg "teileart")
  )
)

;; Wert einer Variante mit Rueckfall auf die Baugruppe. Genutzt fuer
;; "teileart" (die Saeulen-Varianten unterscheiden 1 Zoll von 2 Zoll, was im
;; Export sichtbar bleiben muss) und "dummy" (eine Variante darf eine eigene
;; DWG mitbringen, sobald es sie gibt).
(defun geruest-variante-wert (variante bg schluessel / w)
  (setq w (if variante (ssg-json-get variante schluessel)))
  (if (and w (/= w "")) w (ssg-json-get bg schluessel))
)


;; ============================================================
;; TEILE AUSWERTEN
;; ============================================================

;; Anzeigename eines Eintrags: benannte Gruppe ("name") oder Einzelteil
;; ("artikel").
(defun geruest-eintrag-name (eintrag / n)
  (setq n (ssg-json-get eintrag "name"))
  (if (and n (= (type n) 'STR) (/= n ""))
    n
    (ssg-json-get eintrag "artikel")
  )
)

(defun geruest-menge (eintrag / m)
  (setq m (ssg-json-get eintrag "menge"))
  (if (and m (numberp m) (> m 0)) (fix m) 1)
)

;; Sivas-ID als String. Im JSON stehen rein numerische IDs als Zahl
;; (Projektkonvention), zusammengesetzte Codes waeren Strings.
(defun geruest-id-string (wert)
  (cond
    ((null wert) nil)
    ((= (type wert) 'STR) wert)
    ((= (type wert) 'INT) (itoa wert))
    ((= (type wert) 'REAL) (rtos wert 2 0))
  )
)

(defun geruest-wiederholen (wert n / erg i)
  (setq erg nil i 0)
  (if wert
    (while (< i n)
      (setq erg (cons wert erg))
      (setq i (1+ i))
    )
  )
  erg
)

;; Alle Artikelnummern eines Eintrags, jede gemaess "menge" wiederholt.
;; Benannte Gruppen ("teile") werden rekursiv aufgeloest.
(defun geruest-artikelnummern (eintrag / erg teile)
  (setq erg nil)
  (setq teile (ssg-json-get eintrag "teile"))
  (if teile
    (foreach teil teile
      (setq erg (append erg (geruest-artikelnummern teil)))
    )
    (setq erg (geruest-wiederholen
                (geruest-id-string (ssg-json-get eintrag "sivas_id"))
                (geruest-menge eintrag)))
  )
  erg
)


;; ============================================================
;; DIALOG
;; ============================================================

;; Reine Ziffernfolge? atoi allein taugt als Pruefung nicht - "abc" liefert
;; dort still 0.
(defun geruest-zahl-p (s / i c ok)
  (setq ok (> (strlen s) 0) i 1)
  (while (and ok (<= i (strlen s)))
    (setq c (ascii (substr s i 1)))
    (if (or (< c 48) (> c 57)) (setq ok nil))
    (setq i (1+ i))
  )
  ok
)

;; Eingabe aus einem Mengenfeld auswerten.
;; Leer -> Vorgabewert aus dem JSON, gueltig -> Zahl >= 1, sonst nil.
(defun geruest-menge-wert (s vorgabe)
  (setq s (ssg-cfg-trim (if s s "")))
  (cond
    ((= s "") vorgabe)
    ((not (geruest-zahl-p s)) nil)
    ((< (atoi s) 1) nil)
    (T (atoi s))
  )
)

;; Zahl aus dem JSON als Anzeigetext (fehlender Wert -> "").
(defun geruest-zahl-string (w)
  (cond
    ((null w) "")
    ((= (type w) 'STR) w)
    ((= (type w) 'INT) (itoa w))
    ((= (type w) 'REAL) (rtos w 2 0))
    (T "")
  )
)

;; 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
;; (ein Schraubenset bleibt 1 Scheibe + 2 Muttern + 1 Schraube je Satz).
(defun geruest-artikelnummern-n (eintrag anzahl / teile einmal erg i)
  (setq teile (ssg-json-get eintrag "teile"))
  (if teile
    (progn
      (setq einmal nil)
      (foreach teil teile
        (setq einmal (append einmal (geruest-artikelnummern teil)))
      )
      (setq erg nil i 0)
      (while (< i anzahl)
        (setq erg (append erg einmal))
        (setq i (1+ i))
      )
      erg
    )
    (geruest-wiederholen
      (geruest-id-string (ssg-json-get eintrag "sivas_id")) anzahl)
  )
)

;; Index eines Eintrags (Variante oder Anbauteil) ueber seinen Anzeigenamen.
(defun geruest-name-index (name liste / i idx)
  (setq i 0 idx nil)
  (foreach e liste
    (if (and (null idx) (equal (geruest-eintrag-name e) name)) (setq idx i))
    (setq i (1+ i))
  )
  idx
)

;; Schluessel in einer Alist setzen oder anhaengen.
(defun geruest-alist-setzen (alist key wert)
  (if (assoc key alist)
    (subst (cons key wert) (assoc key alist) alist)
    (append alist (list (cons key wert)))
  )
)

;; n-tes Element ersetzen - AutoLISP kann nth nicht schreibend nutzen.
(defun geruest-liste-setzen (lst idx wert / erg i)
  (setq erg nil i 0)
  (foreach e lst
    (setq erg (cons (if (= i idx) wert e) erg))
    (setq i (1+ i))
  )
  (reverse erg)
)

(defun geruest-nil-liste (n / erg i)
  (setq erg nil i 0)
  (while (< i n) (setq erg (cons nil erg)) (setq i (1+ i)))
  erg
)


;; ============================================================
;; KONFIGURATIONEN
;; ============================================================
;; Zwei Quellen: die gepflegte Bibliothek in data/json/geruest.json
;; (schreibgeschuetzt) und die eigenen Zusammenstellungen in
;; cfg/geruest_user.json. Beide werden NICHT vermischt - Benutzerdaten in der
;; versionierten Datendatei wuerden bei jedem Git-Update kollidieren.

(defun geruest-user-pfad ( / )
  (cond
    ((getenv "DXFM_CFG")
      (strcat (vl-string-translate "\\" "/" (getenv "DXFM_CFG"))
              "/geruest_user.json"))
    ((getenv "DXFMAKRO")
      (strcat (vl-string-translate "\\" "/" (getenv "DXFMAKRO"))
              "/cfg/geruest_user.json"))
  )
)

;; Benutzerdatei laden (Baugruppen-id -> Liste von Konfigurationen).
;; Eine fehlende Datei ist kein Fehler - sie entsteht beim ersten Speichern.
(defun geruest-user-daten ( / pfad)
  (if (null *geruest-user-daten*)
    (progn
      (setq pfad (geruest-user-pfad))
      (if (and pfad (findfile pfad))
        (setq *geruest-user-daten* (ssg-json-laden pfad))
      )
    )
  )
  *geruest-user-daten*
)

;; Alle Konfigurationen einer Baugruppe, Bibliothek zuerst.
;; Eintrag: (benutzer-p . json-objekt)
(defun geruest-konfigs (bg / erg)
  (setq erg nil)
  (foreach k (ssg-json-get bg "konfigurationen")
    (setq erg (append erg (list (cons nil k))))
  )
  (foreach k (ssg-json-get (geruest-user-daten) (ssg-json-get bg "id"))
    (setq erg (append erg (list (cons T k))))
  )
  erg
)

;; Anzeigename; eigene Eintraege mit * markiert, damit erkennbar ist, was
;; geloescht werden kann.
(defun geruest-konfig-name (k)
  (strcat (if (car k) "* " "") (ssg-json-get (cdr k) "name"))
)

;; Listenindex einer Konfiguration im popup_list (0 = "<keine>", die
;; Konfigurationen beginnen deshalb bei 1). 0, wenn nicht gefunden.
(defun geruest-konfig-index (name / i idx)
  (setq i 1 idx 0)
  (foreach k *geruest-konfig-liste*
    (if (and (= idx 0) (equal (ssg-json-get (cdr k) "name") name))
      (setq idx i))
    (setq i (1+ i))
  )
  idx
)

;; 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
;; 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)))
  (foreach e (ssg-json-get konfig schluessel)
    (setq idx (geruest-name-index (ssg-json-get e "artikel") anbauteile))
    (if idx
      (progn
        (setq n (ssg-json-get e "menge"))
        (setq mengen (geruest-liste-setzen mengen idx
                       (if (and n (numberp n) (> n 0)) (fix n) 1)))
      )
      (princ (ssg-textf "gr-konfig-teil-unbekannt"
               (list (ssg-json-get e "artikel")
                     (ssg-json-get konfig "name"))))
    )
  )
  mengen
)


;; ============================================================
;; DIALOGDEFINITION ERZEUGEN
;; ============================================================
;; Die Anbauteil-Zeilen haengen an der Baugruppe, deshalb wird die DCL-Datei
;; pro Aufruf geschrieben statt fest vorgehalten: DCL kann weder Dateien
;; einbinden noch Tiles zur Laufzeit erzeugen, und eine Liste (list_box) kann
;; keine Eingabefelder enthalten - ohne Generierung gaebe es also kein
;; Mengenfeld je Teil.

;; Ein Anfuehrungszeichen im Artikelnamen wuerde das DCL-Label vorzeitig
;; beenden und die erzeugte Datei unbrauchbar machen (fuenf Bezeichnungen
;; enthalten eines, z.B. ROHRKLAMMER 1" KPL. VERTIKAL). Betrifft nur die
;; Anzeige - ARTINR und BEZEICHNUNG nutzen weiter den Originalnamen.
(defun geruest-dcl-label (s / i c erg)
  (if (null s) (setq s ""))
  (setq erg "" i 1)
  (while (<= i (strlen s))
    (setq c (substr s i 1))
    (setq erg (strcat erg (if (= c "\"") "''" c)))
    (setq i (1+ i))
  )
  erg
)

;; Eine Befestigungsspalte. Das Mengenfeld steht LINKS vom Ankreuzfeld: die
;; Eingabefelder sind dadurch alle gleich breit und die Teilenamen beginnen
;; auf gleicher Hoehe - DCL richtet Zeileninhalte nicht von sich aus aus.
;;
;; Zwei DCL-Eigenheiten muessen dafuer gesetzt werden:
;; - alignment = left, weil DCL Tiles in einer Spalte sonst ZENTRIERT: bei
;;   unterschiedlich langen Teilenamen wandern die Zeilen sonst verschieden
;;   weit nach rechts und die Liste franst aus.
;; - fixed_width = true auf der Zeile, weil eine gestreckte row ihre Tiles
;;   ueber die volle Breite VERTEILT - zwischen Mengenfeld und Ankreuzfeld
;;   klaffte dadurch eine wechselnd grosse Luecke. Mit fixed_width wird die
;;   Zeile nur so breit wie ihr Inhalt, das Ankreuzfeld sitzt also direkt am
;;   Mengenfeld.
(defun geruest-dcl-spalte (f anbauteile prefix titel / i)
  (write-line "    : boxed_column {" f)
  (write-line (strcat "      label = \"" titel "\";") f)
  (write-line "      alignment = left;" f)
  (setq i 0)
  (foreach a anbauteile
    (write-line "      : row {" f)
    (write-line "        alignment = left;" f)
    (write-line "        fixed_width = true;" f)
    (write-line (strcat "        : edit_box { key = \"" prefix "m" (itoa i)
                        "\"; label = \"\"; edit_width = 3;"
                        " fixed_width = true; }") f)
    (write-line (strcat "        : toggle { key = \"" prefix (itoa i)
                        "\"; label = \""
                        (geruest-dcl-label (geruest-eintrag-name a))
                        "\"; fixed_width = true; }") f)
    (write-line "      }" f)
    (setq i (1+ i))
  )
  (write-line "    }" f)
)

;; Rueckgabe: Pfad der temporaeren DCL-Datei oder nil.
(defun geruest-dcl-schreiben (anbauteile / pfad f)
  (setq pfad (vl-filename-mktemp "geruest" nil ".dcl"))
  (setq f (open pfad "w"))
  (if (null f)
    nil
    (progn
      (write-line "geruest : dialog {" f)
      (write-line "  label = \"Geruest-Baugruppe konfigurieren\";" f)
      ;; Bereichswechsel (Rohrabhaenger/Saeulen/Wandbefestigung). DCL hat kein
      ;; Reiter-Tile, deshalb ein Dropdown; sein Rueckruf schliesst den Dialog
      ;; und die Schleife baut ihn mit dem neuen Bereich neu auf - die
      ;; Teilezeilen unterscheiden sich je Bereich und lassen sich zur
      ;; Laufzeit nicht austauschen.
      (write-line "  : popup_list { key = \"bereich\"; label = \"Bereich:\"; width = 30; }" f)
      (write-line "  : text { key = \"kopf\"; label = \"\"; width = 64; }" f)
      (write-line "  : row {" f)
      (write-line "    : popup_list { key = \"konfig\"; label = \"Konfiguration:\"; width = 40; }" f)
      (write-line "    : button { key = \"kspeichern\"; label = \"Speichern...\"; fixed_width = true; }" f)
      (write-line "    : button { key = \"kloeschen\"; label = \"Loeschen\"; fixed_width = true; }" f)
      (write-line "  }" f)
      (write-line "  : boxed_column {" f)
      (write-line "    label = \"Basis\";" f)
      (write-line "    : popup_list { key = \"variante\"; label = \"Variante:\"; width = 56; }" f)
      (write-line "    : row {" f)
      (write-line "      : edit_box { key = \"laenge\"; label = \"Laenge (mm):\"; edit_width = 10; }" f)
      (write-line "      : popup_list { key = \"farbe\"; label = \"Farbe:\"; width = 25; }" f)
      (write-line "      : edit_box { key = \"farbe_frei\"; label = \"eigene:\"; edit_width = 12; }" f)
      (write-line "    }" f)
      (write-line "  }" f)
      ;; Ohne Anbauteile bleiben die Spalten weg - ein leerer Cluster ist
      ;; in DCL nicht zulaessig (betrifft z.B. die 1-Zoll-Saeule).
      (if (> (length anbauteile) 0)
        (progn
          (write-line "  : row {" f)
          (geruest-dcl-spalte f anbauteile "o" "Befestigung oben (Anzahl / Teil)")
          (geruest-dcl-spalte f anbauteile "u" "Befestigung unten (Anzahl / Teil)")
          (write-line "  }" f)
        )
      )
      (write-line "  ok_cancel;" f)
      (write-line "}" f)
      (close f)
      pfad
    )
  )
)


;; ============================================================
;; DIALOGZUSTAND
;; ============================================================
;; Die Tiles werden in Schleifen gelesen und geschrieben, ihre Anzahl steht
;; erst zur Laufzeit fest. Der Zustand liegt darum in Globals: action_tile
;; wertet seinen Rueckruf als String AUSSERHALB des lexikalischen Scopes der
;; Dialogfunktion aus, auf deren Locals kaeme er nicht.

;; Ausgangszustand einer Spalte: nichts angehakt, Mengenfeld mit der
;; JSON-Vorgabe vorbelegt (beim Klemmring also 2).
(defun geruest-dlg-standard ( / erg)
  (setq erg nil)
  (foreach a *geruest-anbauteile*
    (setq erg (append erg (list (cons "0" (itoa (geruest-menge a))))))
  )
  erg
)

;; Mengenliste (nil oder Zahl je Teil) in den Tile-Zustand umsetzen.
(defun geruest-mengen->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)))))))
    (setq i (1+ i))
  )
  erg
)

(defun geruest-dlg-lesen ( / i n)
  (setq *geruest-dlg-variante* (get_tile "variante"))
  (setq *geruest-dlg-laenge*   (get_tile "laenge"))
  (setq *geruest-dlg-farbe*    (get_tile "farbe"))
  (setq *geruest-dlg-frei*     (get_tile "farbe_frei"))
  (setq *geruest-dlg-konfig*   (get_tile "konfig"))
  (setq *geruest-dlg-bereich*  (get_tile "bereich"))
  (setq n (length *geruest-anbauteile*) i 0)
  (setq *geruest-dlg-oben* nil *geruest-dlg-unten* nil)
  (while (< i n)
    (setq *geruest-dlg-oben*
      (append *geruest-dlg-oben*
        (list (cons (get_tile (strcat "o" (itoa i)))
                    (get_tile (strcat "om" (itoa i)))))))
    (setq *geruest-dlg-unten*
      (append *geruest-dlg-unten*
        (list (cons (get_tile (strcat "u" (itoa i)))
                    (get_tile (strcat "um" (itoa i)))))))
    (setq i (1+ i))
  )
  (princ)
)

(defun geruest-dlg-schreiben ( / i n paar)
  (set_tile "variante"   *geruest-dlg-variante*)
  (set_tile "laenge"     *geruest-dlg-laenge*)
  ;; Nur setzen, wenn die Liste ueberhaupt gefuellt ist - ein Index auf eine
  ;; leere popup_list ist nicht definiert (Baugruppen ohne attribute-Block).
  (if *geruest-farb-liste* (set_tile "farbe" *geruest-dlg-farbe*))
  (set_tile "farbe_frei" *geruest-dlg-frei*)
  (setq n (length *geruest-anbauteile*) i 0)
  (while (< i n)
    (setq paar (nth i *geruest-dlg-oben*))
    (set_tile (strcat "o"  (itoa i)) (car paar))
    (set_tile (strcat "om" (itoa i)) (cdr paar))
    (setq paar (nth i *geruest-dlg-unten*))
    (set_tile (strcat "u"  (itoa i)) (car paar))
    (set_tile (strcat "um" (itoa i)) (cdr paar))
    (setq i (1+ i))
  )
  (princ)
)

;; Aktuell gewaehlte Farbe als Text.
(defun geruest-dlg-farbwert ( / idx)
  (setq idx (atoi *geruest-dlg-farbe*))
  (cond
    ((null *geruest-farb-liste*) "")
    ((= idx *geruest-frei-idx*) *geruest-dlg-frei*)
    ((nth idx *geruest-farb-liste*) (nth idx *geruest-farb-liste*))
    (T "")
  )
)

;; Konfiguration anwenden und die Tiles nachziehen. Wird direkt aus dem
;; popup_list-Rueckruf aufgerufen - set_tile aendert die Anzeige im laufenden
;; Dialog, ein Neuaufbau ist nicht noetig. Index 0 = "(keine)".
(defun geruest-dlg-konfig-waehlen (idx / k vidx farbe fidx)
  (setq *geruest-dlg-konfig* (itoa idx))
  (if (<= idx 0)
    (progn
      (setq *geruest-dlg-oben*  (geruest-dlg-standard))
      (setq *geruest-dlg-unten* (geruest-dlg-standard))
    )
    (progn
      (setq k (nth (1- idx) *geruest-konfig-liste*))
      (if k
        (progn
          (setq k (cdr k))
          (setq vidx (geruest-name-index (ssg-json-get k "variante")
                                         *geruest-varianten*))
          (if vidx
            (setq *geruest-dlg-variante* (itoa vidx))
            (princ (ssg-textf "gr-konfig-variante-unbekannt"
                     (list (ssg-json-get k "variante")
                           (ssg-json-get k "name"))))
          )
          (setq *geruest-dlg-laenge*
                (geruest-zahl-string (ssg-json-get k "laenge")))
          ;; Farbe: bekannter Wert -> Listeneintrag, sonst Freitext (sofern
          ;; die Baugruppe das zulaesst).
          (setq farbe (ssg-json-get k "teilefarbe"))
          (setq fidx (geruest-name-farbindex farbe))
          (cond
            (fidx (setq *geruest-dlg-farbe* (itoa fidx)
                        *geruest-dlg-frei* ""))
            ((and farbe (/= farbe "") (>= *geruest-frei-idx* 0))
              (setq *geruest-dlg-farbe* (itoa *geruest-frei-idx*)
                    *geruest-dlg-frei* farbe))
          )
          (setq *geruest-dlg-oben*
            (geruest-mengen->tiles
              (geruest-konfig-position k "oben" *geruest-anbauteile*)))
          (setq *geruest-dlg-unten*
            (geruest-mengen->tiles
              (geruest-konfig-position k "unten" *geruest-anbauteile*)))
        )
      )
    )
  )
  (geruest-dlg-schreiben)
  (mode_tile "farbe_frei"
    (if (= (atoi *geruest-dlg-farbe*) *geruest-frei-idx*) 0 1))
  (princ)
)

(defun geruest-name-farbindex (wert / i idx)
  (setq i 0 idx nil)
  (foreach f *geruest-farb-liste*
    (if (and (null idx) (equal f wert)) (setq idx i))
    (setq i (1+ i))
  )
  idx
)

;; Angehakte Teile einer Spalte mit gueltiger Menge einsammeln.
;; Rueckgabe: (T . ((index . menge) ...)) 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)
  (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)))
        (if m
          (setq erg (append erg (list (cons i m))))
          (setq ok nil)
        )
      )
    )
    (setq i (1+ i))
  )
  (if ok (cons T erg))
)

;; Aktuellen Dialogzustand als Konfigurations-Datensatz aufbauen - in
;; derselben Form, die der Parser aus der Datei liefert, damit der Rest des
;; Moduls nicht zwischen Bibliothek und eigener Konfiguration unterscheiden
;; muss.
(defun geruest-dlg-record (name)
  (list (cons "name" name)
        (cons "variante"
              (geruest-eintrag-name
                (nth (atoi *geruest-dlg-variante*) *geruest-varianten*)))
        (cons "laenge" *geruest-dlg-laenge*)
        (cons "teilefarbe" (geruest-dlg-farbwert))
        (cons "oben"  (geruest-dlg-teile *geruest-dlg-oben*))
        (cons "unten" (geruest-dlg-teile *geruest-dlg-unten*))
  )
)

(defun geruest-dlg-teile (zustand / erg i a m)
  (setq erg nil i 0)
  (foreach paar zustand
    (setq a (nth i *geruest-anbauteile*))
    (if (= (car paar) "1")
      (progn
        (setq m (geruest-menge-wert (cdr paar) (geruest-menge a)))
        (if m
          (setq erg (append erg
            (list (list (cons "artikel" (geruest-eintrag-name a))
                        (cons "menge" m)))))
        )
      )
    )
    (setq i (1+ i))
  )
  erg
)


;; ============================================================
;; BENUTZERKONFIGURATIONEN SCHREIBEN
;; ============================================================
;; Bewusst ein auf dieses Schema zugeschnittener Schreiber und kein
;; generischer JSON-Writer: beim Schreiben ist die Abbildung des Parsers
;; mehrdeutig - eine leere Liste kann aus [], {}, false oder null entstanden
;; sein. Ein generischer Writer wuerde ein Versprechen geben, das er nicht
;; halten kann.

(defun geruest-teile-schreiben (f teile / n i)
  (setq n (length teile) i 0)
  (foreach e teile
    (setq i (1+ i))
    (write-line
      (strcat "        { \"artikel\": \""
              (ssg-json-escape (ssg-json-get e "artikel"))
              "\", \"menge\": " (itoa (ssg-json-get e "menge")) " }"
              (if (< i n) "," ""))
      f)
  )
)

(defun geruest-konfig-liste-schreiben (f konfigs / n i)
  (setq n (length konfigs) i 0)
  (foreach k konfigs
    (setq i (1+ i))
    (write-line "    {" f)
    (write-line (strcat "      \"name\": \""
                        (ssg-json-escape (ssg-json-get k "name")) "\",") f)
    (write-line (strcat "      \"variante\": \""
                        (ssg-json-escape (ssg-json-get k "variante")) "\",") f)
    ;; Laenge als String: sie darf leer sein (Baugruppen ohne Laengenangabe),
    ;; und "laenge": ohne Wert waere kein gueltiges JSON. Der Leser
    ;; (geruest-zahl-string) nimmt String wie Zahl entgegen.
    (write-line (strcat "      \"laenge\": \""
                        (ssg-json-escape (geruest-zahl-string
                                           (ssg-json-get k "laenge"))) "\",") f)
    (write-line (strcat "      \"teilefarbe\": \""
                        (ssg-json-escape (ssg-json-get k "teilefarbe")) "\",") f)
    (write-line "      \"oben\": [" f)
    (geruest-teile-schreiben f (ssg-json-get k "oben"))
    (write-line "      ]," f)
    (write-line "      \"unten\": [" f)
    (geruest-teile-schreiben f (ssg-json-get k "unten"))
    (write-line "      ]" f)
    (write-line (if (< i n) "    }," "    }") f)
  )
)

;; cfg/geruest_user.json komplett neu schreiben.
(defun geruest-user-schreiben ( / pfad f n i)
  (setq pfad (geruest-user-pfad))
  (if (null pfad)
    (progn (princ (ssg-text "gr-fehler-datenpfad")) nil)
    (progn
      (setq f (open pfad "w"))
      (if (null f)
        (progn (princ (ssg-textf "gr-fehler-schreiben" (list pfad))) nil)
        (progn
          (write-line "{" f)
          (setq n (length *geruest-user-daten*) i 0)
          (foreach bgruppe *geruest-user-daten*
            (setq i (1+ i))
            (write-line (strcat "  \"" (ssg-json-escape (car bgruppe))
                                "\": [") f)
            (geruest-konfig-liste-schreiben f (cdr bgruppe))
            (write-line (if (< i n) "  ]," "  ]") f)
          )
          (write-line "}" f)
          (close f)
          T
        )
      )
    )
  )
)

;; Eigene Konfiguration ablegen; ein gleichnamiger eigener Eintrag wird
;; ersetzt. Die Bibliothek aus geruest.json bleibt unberuehrt.
(defun geruest-konfig-sichern (bg name / id liste neu ersetzt)
  (setq id (ssg-json-get bg "id"))
  (setq neu (geruest-dlg-record name))
  (setq ersetzt nil)
  (setq liste
    (mapcar '(lambda (k)
               (if (equal (ssg-json-get k "name") name)
                 (progn (setq ersetzt T) neu)
                 k))
            (ssg-json-get (geruest-user-daten) id)))
  (if (not ersetzt) (setq liste (append liste (list neu))))
  (setq *geruest-user-daten*
        (geruest-alist-setzen (geruest-user-daten) id liste))
  (if (geruest-user-schreiben)
    (princ (ssg-textf "gr-konfig-gespeichert" (list name)))
  )
)

;; Gewaehlte eigene Konfiguration nach Rueckfrage entfernen.
(defun geruest-konfig-entfernen (bg / idx k id name liste)
  (setq idx (atoi *geruest-dlg-konfig*))
  (if (<= idx 0)
    (princ (ssg-text "gr-konfig-nichts-gewaehlt"))
    (progn
      (setq k (nth (1- idx) *geruest-konfig-liste*))
      (cond
        ((null k) nil)
        ((null (car k)) (princ (ssg-text "gr-konfig-bibliothek-fest")))
        (T
          (setq name (ssg-json-get (cdr k) "name"))
          (initget "Ja Nein")
          (if (equal (getkword (ssg-textf "gr-konfig-loeschen-frage"
                                 (list name))) "Ja")
            (progn
              (setq id (ssg-json-get bg "id"))
              (setq liste (vl-remove-if
                            '(lambda (e)
                               (equal (ssg-json-get e "name") name))
                            (ssg-json-get (geruest-user-daten) id)))
              (setq *geruest-user-daten*
                    (geruest-alist-setzen (geruest-user-daten) id liste))
              (if (geruest-user-schreiben)
                (princ (ssg-textf "gr-konfig-geloescht" (list name))))
              (setq *geruest-dlg-konfig* "0")
            )
          )
        )
      )
    )
  )
)

;; Dialogzustand eines Bereichs sichern bzw. zurueckholen, damit ein
;; Bereichswechsel die Eingaben nicht verwirft.
(defun geruest-zustand-sichern (id)
  (setq *geruest-zustand*
    (geruest-alist-setzen *geruest-zustand* id
      (list *geruest-dlg-variante* *geruest-dlg-laenge* *geruest-dlg-farbe*
            *geruest-dlg-frei* *geruest-dlg-konfig*
            *geruest-dlg-oben* *geruest-dlg-unten*)))
)

;; Rueckgabe T, wenn ein passender Zustand gefunden und gesetzt wurde. Die
;; Laengenpruefung faengt den Fall ab, dass die Datendatei zwischen zwei
;; Aufrufen geaendert wurde und die Teilezahl nicht mehr passt.
(defun geruest-zustand-laden (id / z)
  (setq z (cdr (assoc id *geruest-zustand*)))
  (if (and z (= (length (nth 5 z)) (length *geruest-anbauteile*)))
    (progn
      (setq *geruest-dlg-variante* (nth 0 z)
            *geruest-dlg-laenge*   (nth 1 z)
            *geruest-dlg-farbe*    (nth 2 z)
            *geruest-dlg-frei*     (nth 3 z)
            *geruest-dlg-konfig*   (nth 4 z)
            *geruest-dlg-oben*     (nth 5 z)
            *geruest-dlg-unten*    (nth 6 z))
      T
    )
  )
)

;; Dialog fuer einen Bereich zeigen. Rueckgabe:
;;   ("OK" variante-index ((idx . menge) ...) ((idx . menge) ...) laenge farbe)
;;     - drittes Element = Befestigung oben, viertes = unten
;;   ("WECHSEL" bereich-index) - Nutzer hat den Bereich umgestellt
;;   nil - abgebrochen
(defun geruest-dialog (bg bereich-idx bereiche / dcl-pfad dat attr laenge-def
                         farb-opts frei-opt min-l max-l fertig rueckgabe
                         ergebnis wert-l oben-m unten-m name neu-idx)
  (setq *geruest-varianten*  (ssg-json-get bg "geometrie_varianten"))
  (setq *geruest-anbauteile* (ssg-json-get bg "anbaugruppen"))
  (setq attr       (ssg-json-get bg "attribute"))
  (setq laenge-def (if attr (ssg-json-get attr "Laenge")))
  (setq farb-opts  (if attr (ssg-json-get attr "Teilefarbe")))
  (setq min-l (if laenge-def (ssg-json-get laenge-def "min")))
  (setq max-l (if laenge-def (ssg-json-get laenge-def "max")))

  ;; Farboptionen + freie Option ans Listenende; Index davon merkt sich der
  ;; Callback, um das Freitextfeld freizuschalten.
  (setq *geruest-farb-liste* nil *geruest-frei-idx* -1)
  (if farb-opts
    (progn
      (setq *geruest-farb-liste* (ssg-json-get farb-opts "optionen"))
      (if (ssg-json-get farb-opts "frei_erlaubt")
        (progn
          (setq frei-opt (ssg-json-get farb-opts "frei_option"))
          (if (null frei-opt) (setq frei-opt "Individuell"))
          (setq *geruest-frei-idx* (length *geruest-farb-liste*))
          (setq *geruest-farb-liste*
                (append *geruest-farb-liste* (list frei-opt)))
        )
      )
    )
  )

  (setq *geruest-konfig-liste* (geruest-konfigs bg))
  ;; Frueheren Stand dieses Bereichs wiederherstellen, sonst Ausgangszustand
  (if (null (geruest-zustand-laden (ssg-json-get bg "id")))
    (progn
      (setq *geruest-dlg-variante* "0" *geruest-dlg-laenge* ""
            *geruest-dlg-farbe* "0" *geruest-dlg-frei* ""
            *geruest-dlg-konfig* "0")
      (setq *geruest-dlg-oben*  (geruest-dlg-standard))
      (setq *geruest-dlg-unten* (geruest-dlg-standard))
    )
  )
  (setq fertig nil rueckgabe nil)

  ;; Die Dialogdefinition haengt nur an der Teileliste, nicht am Zustand -
  ;; einmal erzeugen und erst nach der Schleife loeschen (unload_dialog muss
  ;; vorher gelaufen sein).
  (setq dcl-pfad (geruest-dcl-schreiben *geruest-anbauteile*))

  ;; Schleife: ungueltige Eingaben, Speichern und Loeschen zeigen den Dialog
  ;; mit dem bisherigen Stand erneut (Projektmuster, vgl. vf_linienzug).
  (while (not fertig)
    (setq dat (if dcl-pfad (load_dialog dcl-pfad) -1))
    (if (or (null dcl-pfad) (< dat 0) (not (new_dialog "geruest" dat)))
      (progn
        (alert (ssg-text "gr-fehler-dcl"))
        (setq fertig T)
      )
      (progn
        (start_list "bereich")
        (foreach b bereiche (add_list (geruest-titel (cdr b))))
        (end_list)
        (set_tile "bereich" (itoa bereich-idx))

        (set_tile "kopf" (ssg-textf "gr-dlg-kopf" (list (geruest-titel bg))))

        (start_list "konfig")
        (add_list (ssg-text "gr-konfig-keine"))
        (foreach k *geruest-konfig-liste* (add_list (geruest-konfig-name k)))
        (end_list)
        (set_tile "konfig" *geruest-dlg-konfig*)

        (start_list "variante")
        (foreach v *geruest-varianten* (add_list (geruest-eintrag-name v)))
        (end_list)

        (if *geruest-farb-liste*
          (progn
            (start_list "farbe")
            (foreach f *geruest-farb-liste* (add_list f))
            (end_list)
          )
        )

        ;; Alle Tiles aus dem Zustand fuellen (auch Haken und Mengenfelder)
        (geruest-dlg-schreiben)

        ;; Laenge/Farbe nur bei Baugruppen mit "attribute"-Block
        (if (null laenge-def) (mode_tile "laenge" 1))
        (if *geruest-farb-liste*
          (progn
            (mode_tile "farbe_frei"
              (if (= (atoi *geruest-dlg-farbe*) *geruest-frei-idx*) 0 1))
            (action_tile "farbe"
              "(mode_tile \"farbe_frei\" (if (= (atoi $value) *geruest-frei-idx*) 0 1))")
          )
          (progn
            (mode_tile "farbe" 1)
            (mode_tile "farbe_frei" 1)
          )
        )

        (action_tile "konfig" "(geruest-dlg-konfig-waehlen (atoi $value))")
        ;; Bereichswechsel: Dialog schliessen, die Schleife in c:GERUEST baut
        ;; ihn mit dem neuen Bereich neu auf.
        (action_tile "bereich" "(geruest-dlg-lesen) (done_dialog 4)")
        (action_tile "accept"     "(geruest-dlg-lesen) (done_dialog 1)")
        (action_tile "kspeichern" "(geruest-dlg-lesen) (done_dialog 2)")
        (action_tile "kloeschen"  "(geruest-dlg-lesen) (done_dialog 3)")
        (action_tile "cancel" "(done_dialog 0)")
        (setq ergebnis (start_dialog))
        (unload_dialog dat)

        (cond
          ((= ergebnis 0) (setq fertig T))

          ;; Bereichswechsel: Stand dieses Bereichs sichern und an den
          ;; Aufrufer zurueckmelden, damit er den neuen Bereich oeffnet.
          ((= ergebnis 4)
            (setq neu-idx (atoi *geruest-dlg-bereich*))
            (geruest-zustand-sichern (ssg-json-get bg "id"))
            (if (= neu-idx bereich-idx)
              nil
              (progn
                (setq rueckgabe (list "WECHSEL" neu-idx))
                (setq fertig T)
              )
            )
          )

          ;; Speichern: der Name wird NACH dem Schliessen abgefragt -
          ;; getstring funktioniert aus einem action_tile-Rueckruf heraus
          ;; nicht (dasselbe Muster wie die Punktwahl im VF-Assistenten).
          ((= ergebnis 2)
            (setq name (getstring T (ssg-text "gr-konfig-name")))
            (if (and name (/= (ssg-cfg-trim name) ""))
              (progn
                (setq name (ssg-cfg-trim name))
                (geruest-konfig-sichern bg name)
                (setq *geruest-konfig-liste* (geruest-konfigs bg))
                ;; Gerade gespeicherten Eintrag auswaehlen, damit Liste und
                ;; angezeigter Stand zusammenpassen (Index 0 = "<keine>").
                (setq *geruest-dlg-konfig*
                      (itoa (geruest-konfig-index name)))
              )
              (progn
                (princ (ssg-text "gr-abgebrochen"))
                (setq *geruest-konfig-liste* (geruest-konfigs bg))
              )
            )
          )

          ((= ergebnis 3)
            (geruest-konfig-entfernen bg)
            (setq *geruest-konfig-liste* (geruest-konfigs bg))
          )

          ;; Laenge pruefen - Bereichspruefung erfolgt im Projekt immer nach
          ;; done_dialog, DCL kann das nicht.
          ((and laenge-def
                (progn (setq wert-l (atof *geruest-dlg-laenge*))
                       (or (= (ssg-cfg-trim *geruest-dlg-laenge*) "")
                           (and min-l (< wert-l min-l))
                           (and max-l (> wert-l max-l)))))
            (alert (ssg-textf "gr-alert-laenge"
                     (list *geruest-dlg-laenge*
                           (if min-l (rtos min-l 2 0) "0")
                           (if max-l (rtos max-l 2 0) "-"))))
          )

          (T
            (setq oben-m  (geruest-mengen-lesen *geruest-dlg-oben*))
            (setq unten-m (geruest-mengen-lesen *geruest-dlg-unten*))
            (if (or (null oben-m) (null unten-m))
              (alert (ssg-text "gr-alert-menge"))
              (progn
                (setq rueckgabe
                  (list "OK"
                        (atoi *geruest-dlg-variante*)
                        (cdr oben-m)
                        (cdr unten-m)
                        (if laenge-def *geruest-dlg-laenge* "")
                        (geruest-dlg-farbwert)))
                (setq fertig T)
              )
            )
          )
        )
      )
    )
  )
  (if dcl-pfad (vl-file-delete dcl-pfad))
  rueckgabe
)


;; ============================================================
;; BLOCK BAUEN UND EINFUEGEN
;; ============================================================

;; Eindeutiger Blockname. ssg-timestamp hat Sekundenaufloesung - bei zwei
;; Aufrufen in derselben Sekunde wird ein Zaehler angehaengt (Muster aus
;; OmniModulInsert.lsp).
(defun geruest-blockname (id / bname)
  (setq bname (strcat "GR_" id "_" (ssg-timestamp)))
  (while (tblsearch "BLOCK" bname)
    (setq *geruest-block-counter* (1+ *geruest-block-counter*))
    (setq bname (strcat "GR_" id "_" (ssg-timestamp) "_"
                        (itoa *geruest-block-counter*)))
  )
  bname
)

;; Dummy-Geometrie + eigene ATTDEFs zu einem Block zusammenfassen und am
;; gewaehlten Punkt einfuegen. werte = alist der berechneten Attributwerte,
;; variante = gewaehlte Geometrie-Variante (liefert ggf. eine eigene DWG).
;; Rueckgabe: (blockname . entity) oder nil.
(defun geruest-block-bauen (bg variante werte pt / datei dummy lastEnt dummyEnt
                               e ss bname blockEnt 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))
  (if (or (null dummy) (null (findfile dummy)))
    (progn
      (princ (ssg-textf "gr-fehler-dummy" (list (if dummy dummy datei))))
      nil
    )
    (progn
      (setvar "ATTREQ" 0)
      (setvar "ATTDIA" 0)
      (setvar "OSMODE" 0)
      (setq lastEnt (entlast))

      ;; Dummy bei (0,0,0) einfuegen - seine Attribute liefern u.a. die
      ;; LAYER-Vorgabe.
      (command "_.INSERT" dummy (list 0.0 0.0 0.0) 1 1 0)
      (setq dummyEnt (entlast))
      (setq dummy-attribs (ssg-attrib-read dummyEnt))

      ;; Unser Schema gewinnt an Struktur, die Dummy-Werte an Inhalt:
      ;; ssg-attrib-merge legt alle Tags aus *geruest-attrib-defs* an und
      ;; uebernimmt zusaetzlich alle Tags der Dummy-DWG.
      (setq attribs (ssg-attrib-merge dummy-attribs *geruest-attrib-defs*))
      (foreach paar werte
        (if (assoc (car paar) attribs)
          (setq attribs (subst paar (assoc (car paar) attribs) attribs))
          (setq attribs (append attribs (list paar)))
        )
      )

      (ssg-attrib-make-defs (ssg-attrib-alist-to-defs attribs) 50.0)

      ;; Alles Neue seit lastEnt einsammeln (Dummy-INSERT + ATTDEFs)
      (setq ss (ssadd))
      (setq e (if lastEnt (entnext lastEnt) (entnext)))
      (while e
        (ssadd e ss)
        (setq e (entnext e))
      )

      (setq bname (geruest-blockname (ssg-json-get bg "id")))
      (command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")

      ;; Stand VOR dem Einfuegen merken: bricht der Nutzer die Drehung mit ESC
      ;; ab, entsteht kein neues INSERT und (entlast) zeigt auf ein voellig
      ;; fremdes Objekt - ohne diesen Vergleich wuerden dessen Attribute
      ;; ueberschrieben.
      (setq lastEnt (entlast))
      ;; pause = Drehwinkel interaktiv am Cursor
      (command "_.INSERT" bname pt 1 1 pause)
      ;; Laufende Einfuegung sicher beenden (z.B. ESC waehrend der Drehung)
      (if (> (getvar "CMDACTIVE") 0) (command))
      (if (> (getvar "CMDACTIVE") 0) (command))

      (setq blockEnt (entlast))
      (if (and blockEnt (not (eq blockEnt lastEnt))
               (= (cdr (assoc 0 (entget blockEnt))) "INSERT"))
        (progn
          (ssg-attrib-set-on blockEnt attribs)
          (ssg-block-layer-vorgabe blockEnt bname attribs)
          (cons bname blockEnt)
        )
      )
    )
  )
)


;; ============================================================
;; ABLAUF
;; ============================================================

;; Artikelnummern einer Befestigungsauswahl ((index . menge) ...).
(defun geruest-auswahl-artnr (auswahl anbauteile / erg)
  (setq erg nil)
  (foreach paar auswahl
    (setq erg (append erg
      (geruest-artikelnummern-n (nth (car paar) anbauteile) (cdr paar))))
  )
  erg
)

;; Namensteile einer Befestigungsauswahl fuer die BEZEICHNUNG,
;; z.B. ("oben 2x ROHRKLAMMER 1\" KPL. VERTIKAL").
(defun geruest-auswahl-namen (auswahl anbauteile position / erg)
  (setq erg nil)
  (foreach paar auswahl
    (setq erg (append erg
      (list (strcat position " " (itoa (cdr paar)) "x "
                    (geruest-eintrag-name (nth (car paar) anbauteile))))))
  )
  erg
)

;; Ausgewaehlte Konfiguration einfuegen.
;; wahl = (variante-index oben unten laenge farbe) - die Dialog-Rueckgabe ohne
;; das fuehrende "OK".
(defun geruest-einfuegen (bg wahl / varianten anbauteile variante teileart
                             artnr bezeichnung teile-namen werte pt ergebnis)
  (setq varianten  (ssg-json-get bg "geometrie_varianten"))
  (setq anbauteile (ssg-json-get bg "anbaugruppen"))
  (setq variante   (nth (car wahl) varianten))
  ;; TEILEART kann die Variante vorgeben (Saeule 1 Zoll vs. 2 Zoll) -
  ;; sonst gilt der Wert der Baugruppe.
  (setq teileart (geruest-variante-wert variante bg "teileart"))

  ;; ARTINR: jede Sivas-ID so oft wie die gewaehlte Stueckzahl, erst die
  ;; Basis, dann Befestigung oben, dann unten. Dasselbe Teil an beiden
  ;; Positionen erscheint entsprechend mehrfach.
  (setq artnr (geruest-artikelnummern variante))
  (setq artnr (append artnr (geruest-auswahl-artnr (cadr wahl) anbauteile)))
  (setq artnr (append artnr (geruest-auswahl-artnr (caddr wahl) anbauteile)))

  ;; BEZEICHNUNG: mit " + " verketten - die Artikelbezeichnungen enthalten
  ;; selbst Kommas ("ROHR R 1\" 33,7 x 2,6").
  (setq teile-namen (list teileart (geruest-eintrag-name variante)))
  (setq teile-namen (append teile-namen
    (geruest-auswahl-namen (cadr wahl) anbauteile
      (ssg-text "gr-position-oben"))))
  (setq teile-namen (append teile-namen
    (geruest-auswahl-namen (caddr wahl) anbauteile
      (ssg-text "gr-position-unten"))))
  (setq bezeichnung (ssg-join teile-namen " + "))

  (setq werte (list (cons "ARTINR"      (ssg-join artnr ","))
                    (cons "BEZEICHNUNG" bezeichnung)
                    (cons "TEILEART"    teileart)))
  (if (/= (nth 3 wahl) "")
    (setq werte (append werte (list (cons "LAENGE" (nth 3 wahl))))))
  (if (/= (nth 4 wahl) "")
    (setq werte (append werte (list (cons "TEILEFARBE" (nth 4 wahl))))))

  (setq pt (getpoint (ssg-text "gr-prompt-einfuegepunkt")))
  (if (null pt)
    (princ (ssg-text "gr-abgebrochen"))
    (progn
      (ssg-start "Geruest" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
      (setq ergebnis (geruest-block-bauen bg variante werte pt))
      (ssg-end)
      (if ergebnis
        (princ (ssg-textf "gr-fertig" (list teileart (car ergebnis))))
      )
    )
  )
  (princ)
)


;; Ein Dialog fuer alle Geruest-Bereiche. Der Bereichswechsel laeuft ueber
;; diese Schleife, weil der Dialog dafuer neu aufgebaut werden muss.
(defun c:GERUEST ( / bereiche idx bg erg weiter)
  (setq *geruest-zustand* nil)
  (setq bereiche (geruest-baugruppen-liste))
  (if (null bereiche)
    (princ (ssg-text "gr-fehler-keine-baugruppen"))
    (progn
      (setq idx 0 weiter T)
      (while weiter
        (setq bg (cdr (nth idx bereiche)))
        (cond
          ((null (ssg-json-get bg "geometrie_varianten"))
            (princ (ssg-textf "gr-fehler-keine-varianten"
                     (list (ssg-json-get bg "id"))))
            (setq weiter nil)
          )
          (T
            (setq erg (geruest-dialog bg idx bereiche))
            (cond
              ((null erg)
                (princ (ssg-text "gr-abgebrochen"))
                (setq weiter nil))
              ((equal (car erg) "WECHSEL") (setq idx (cadr erg)))
              (T
                (setq weiter nil)
                (geruest-einfuegen bg (cdr erg)))
            )
          )
        )
      )
    )
  )
  (princ)
)

(princ "\nGeruestInsert.lsp geladen. Befehl: GERUEST")
(princ)