1367 lines
50 KiB
Common Lisp
1367 lines
50 KiB
Common Lisp
;; ============================================================
|
|
;; 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).
|
|
;;
|
|
;; Zusaetzlich wird jede ausgewaehlte Artikelnummer (Basis, oben, unten, inkl.
|
|
;; aufgeloester Gruppen), fuer die data/geruest/<artnr>.dwg existiert, einmal
|
|
;; bei 0,0,0 mit in den Block eingefuegt (geruest-teile-dwgs) - reine
|
|
;; Geometrie als visuelle Rueckmeldung, die Attribute bleiben davon unberuehrt.
|
|
;; Teile ohne DWG werden still uebergangen.
|
|
;;
|
|
;; TEILEFARBE ist eine kommagetrennte Liste parallel zu ARTINR: jedes Teil mit
|
|
;; "farbig": true in geruest.json bekommt die im Dialog gewaehlte Farbe, alle
|
|
;; anderen einen leeren Eintrag (geruest-teile-paare/geruest-farbliste).
|
|
;;
|
|
;; 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 Teile eines Eintrags als ((artnr . farbig) ...), jedes gemaess
|
|
;; "menge" 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.
|
|
;; ARTINR und TEILEFARBE entstehen aus DIESEM einen Durchlauf, damit beide
|
|
;; Listen garantiert gleich lang und gleich sortiert sind.
|
|
(defun geruest-teile-paare (eintrag erbe / erg teile farbig)
|
|
(setq erg nil)
|
|
(setq farbig (if (or erbe (ssg-json-get eintrag "farbig")) T nil))
|
|
(setq teile (ssg-json-get eintrag "teile"))
|
|
(if teile
|
|
(foreach teil teile
|
|
(setq erg (append erg (geruest-teile-paare teil farbig)))
|
|
)
|
|
(setq erg (mapcar '(lambda (nr) (cons nr farbig))
|
|
(geruest-wiederholen
|
|
(geruest-id-string (ssg-json-get eintrag "sivas_id"))
|
|
(geruest-menge eintrag))))
|
|
)
|
|
erg
|
|
)
|
|
|
|
;; Alle Artikelnummern eines Eintrags, jede gemaess "menge" wiederholt.
|
|
(defun geruest-artikelnummern (eintrag)
|
|
(mapcar 'car (geruest-teile-paare eintrag nil))
|
|
)
|
|
|
|
;; TEILEFARBE-Liste zu Teile-Paaren: die Baugruppenfarbe fuer jedes farbige
|
|
;; Teil, "" fuer alle anderen.
|
|
(defun geruest-farbliste (paare farbe)
|
|
(mapcar '(lambda (p) (if (cdr p) farbe "")) paare)
|
|
)
|
|
|
|
;; Liste ohne Duplikate, Reihenfolge des ersten Auftretens bleibt erhalten.
|
|
(defun geruest-eindeutig (lst / erg)
|
|
(setq erg nil)
|
|
(foreach e lst
|
|
(if (not (member e erg)) (setq erg (cons e erg)))
|
|
)
|
|
(reverse erg)
|
|
)
|
|
|
|
;; Teile-DWGs zu einer Liste von Artikelnummern: data/geruest/<artnr>.dwg,
|
|
;; soweit vorhanden. Jede Nummer nur einmal - alle Teile sitzen bei 0,0,0,
|
|
;; eine Mehrfach-Stueckzahl waere visuell nicht unterscheidbar. Fehlende
|
|
;; DWGs werden still uebergangen.
|
|
(defun geruest-teile-dwgs (artnr-liste / erg pfad)
|
|
(setq erg nil)
|
|
(foreach nr (geruest-eindeutig artnr-liste)
|
|
(if (and nr
|
|
(setq pfad (geruest-dummy-pfad (strcat nr ".dwg")))
|
|
(findfile pfad))
|
|
(setq erg (cons pfad erg))
|
|
)
|
|
)
|
|
(reverse 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-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-artikelnummern-n (eintrag anzahl)
|
|
(mapcar 'car (geruest-teile-paare-n eintrag 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).
|
|
;; teile-dwgs = Pfade der Teile-DWGs (geruest-teile-dwgs), die zusaetzlich
|
|
;; als reine Geometrie bei 0,0,0 mit in den Block wandern.
|
|
;; Rueckgabe: (blockname . entity) oder nil.
|
|
(defun geruest-block-bauen (bg variante werte pt teile-dwgs / 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)
|
|
;; Nicht (entlast): ist das letzte Objekt ein Block mit Attributen (z.B.
|
|
;; eine per Strg+C/V eingefuegte GR_-Kopie), wuerden dessen ATTRIBs mit
|
|
;; eingesammelt und von _.-BLOCK entfernt.
|
|
(setq lastEnt (ssg-lastent-ohne-attribute))
|
|
|
|
;; 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))
|
|
|
|
;; Ausgewaehlte Teile mit eigener DWG als sichtbare Rueckmeldung
|
|
;; einfuegen - erst NACH dem Lesen des Dummys, damit dummyEnt auf den
|
|
;; Dummy zeigt. Nur Geometrie: die Sammelschleife unten nimmt die
|
|
;; INSERTs mit in den Block, das Attribut-Schema bleibt unberuehrt.
|
|
(foreach teil teile-dwgs
|
|
(command "_.INSERT" teil (list 0.0 0.0 0.0) 1 1 0)
|
|
)
|
|
|
|
;; 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
|
|
;; ============================================================
|
|
|
|
;; Teile-Paare ((artnr . farbig) ...) einer Befestigungsauswahl
|
|
;; ((index . menge) ...).
|
|
(defun geruest-auswahl-paare (auswahl anbauteile / erg)
|
|
(setq erg nil)
|
|
(foreach paar auswahl
|
|
(setq erg (append erg
|
|
(geruest-teile-paare-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
|
|
paare 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. Die Paare tragen zusaetzlich
|
|
;; das farbig-Flag je Teil fuer die TEILEFARBE-Liste (gleiche Reihenfolge).
|
|
(setq paare (geruest-teile-paare variante nil))
|
|
(setq paare (append paare (geruest-auswahl-paare (cadr wahl) anbauteile)))
|
|
(setq paare (append paare (geruest-auswahl-paare (caddr wahl) anbauteile)))
|
|
(setq artnr (mapcar 'car paare))
|
|
|
|
;; 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))))))
|
|
;; TEILEFARBE: je ARTINR-Eintrag die gewaehlte Farbe (farbiges Teil) oder
|
|
;; "" (z.B. ",,RAL7030,,RAL7030") - fuer den Sivas-Export je Artikelnummer.
|
|
(if (/= (nth 4 wahl) "")
|
|
(setq werte (append werte (list (cons "TEILEFARBE"
|
|
(ssg-join (geruest-farbliste paare (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
|
|
(geruest-teile-dwgs artnr)))
|
|
(ssg-end)
|
|
(if ergebnis
|
|
(princ (ssg-textf "gr-fertig" (list teileart (car ergebnis))))
|
|
)
|
|
)
|
|
)
|
|
(princ)
|
|
)
|
|
|
|
|
|
;; Index eines Bereichs ueber das ASCII-Feld "id" (nil, wenn unbekannt).
|
|
(defun geruest-bereich-index (id bereiche / i idx)
|
|
(setq i 0 idx nil)
|
|
(foreach b bereiche
|
|
(if (and (null idx) (equal (car b) id)) (setq idx i))
|
|
(setq i (1+ i))
|
|
)
|
|
idx
|
|
)
|
|
|
|
;; Ein Dialog fuer alle Geruest-Bereiche. Der Bereichswechsel laeuft ueber
|
|
;; diese Schleife, weil der Dialog dafuer neu aufgebaut werden muss.
|
|
;; start-id = "id" des Bereichs, mit dem der Dialog oeffnet (nil oder
|
|
;; unbekannt -> erster Bereich). Der Wechsel per Dropdown bleibt moeglich.
|
|
(defun geruest-starten (start-id / 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 (if start-id (geruest-bereich-index start-id bereiche)))
|
|
(if (null idx) (setq idx 0))
|
|
(setq 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)
|
|
)
|
|
|
|
(defun c:GERUEST ( / ) (geruest-starten nil))
|
|
|
|
;; Menue-Einstiege je Bereich - oeffnen denselben Dialog im passenden Bereich.
|
|
(defun c:GERUEST_SAEULEN ( / ) (geruest-starten "Saeulen"))
|
|
(defun c:GERUEST_ROHRABHAENGER ( / ) (geruest-starten "Rohrabhaenger"))
|
|
(defun c:GERUEST_WANDBEFESTIGUNG ( / ) (geruest-starten "Wandbefestigung"))
|
|
|
|
(princ "\nGeruestInsert.lsp geladen. Befehle: GERUEST, GERUEST_SAEULEN, GERUEST_ROHRABHAENGER, GERUEST_WANDBEFESTIGUNG")
|
|
(princ)
|