2302 lines
88 KiB
Common Lisp
2302 lines
88 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.
|
|
;; Rohr-Geruest-Traeger (GERUEST_TRAEGER) lesen data/json/geruest_traeger.json.
|
|
;;
|
|
;; Beide Befestigungslisten enthalten ALLE Anbauteile der Baugruppe - dasselbe
|
|
;; Teil kann oben, unten oder gleichzeitig an beiden Positionen sitzen.
|
|
;;
|
|
;; 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" "")
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Rohr-Geruest-Traeger: dasselbe Schema plus die beiden Laengenabzuege und
|
|
;; VARIANTE (Name der Geometrie-Variante). Bewusst ein eigenes Schema - die
|
|
;; anderen GR_-Bloecke behalten ihres. LAENGE ist beim Traeger die
|
|
;; NETTO-Laenge (Strecke minus Abzuege). VARIANTE macht den Block
|
|
;; selbstbeschreibend: GERUEST_TRAEGER_BESCHRIFTEN findet darueber die
|
|
;; Formatierung der Beschriftung, ohne den Dialog zu kennen.
|
|
;; Ohne null-Guard: ein Neuladen der Datei soll ein erweitertes Schema sofort
|
|
;; wirksam machen.
|
|
(setq *geruest-traeger-attrib-defs*
|
|
(append *geruest-attrib-defs*
|
|
'(("LAENGENABZUGANFANG" "")
|
|
("LAENGENABZUGENDE" "")
|
|
("VARIANTE" "")))
|
|
)
|
|
|
|
;; XDATA-App der Traeger-Beschriftung: Gruppe 1005 = Handle des Traeger-Blocks.
|
|
(setq *geruest-beschr-app* "SSG_GR_BESCHR")
|
|
|
|
(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"))
|
|
)
|
|
)
|
|
|
|
;; Pfad einer Datendatei unter data/json, z.B. "geruest.json".
|
|
(defun geruest-json-pfad (datei / basis)
|
|
(if (setq basis (geruest-data-verzeichnis))
|
|
(strcat basis "/json/" datei)
|
|
)
|
|
)
|
|
|
|
(defun geruest-dummy-pfad (datei / basis)
|
|
(if (and datei (setq basis (geruest-data-verzeichnis)))
|
|
(strcat basis "/geruest/" datei)
|
|
)
|
|
)
|
|
|
|
;; Datendatei unter data/json einmal je Zeichnungssitzung laden und im
|
|
;; globalen Symbol cache-sym ablegen. Rueckgabe: die geparsten Daten oder nil
|
|
;; (mit Meldung).
|
|
(defun geruest-json-laden-cache (datei cache-sym / pfad daten)
|
|
(if (null (eval cache-sym))
|
|
(progn
|
|
(setq pfad (geruest-json-pfad datei))
|
|
(cond
|
|
((null pfad) (princ (ssg-text "gr-fehler-datenpfad")))
|
|
((null (findfile pfad)) (princ (ssg-textf "gr-fehler-json-fehlt" (list pfad))))
|
|
(T
|
|
(setq daten (ssg-json-laden pfad))
|
|
(set cache-sym daten)
|
|
(if (null daten)
|
|
(princ (ssg-textf "gr-fehler-json-lesbar" (list pfad)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(eval cache-sym)
|
|
)
|
|
|
|
;; Baugruppen des GERUEST-Dialogs (Rohrabhaenger, Saeulen, Wandbefestigung).
|
|
(defun geruest-daten ( / )
|
|
(geruest-json-laden-cache "geruest.json" '*geruest-daten*)
|
|
)
|
|
|
|
;; Traeger-Baugruppen mit Linien-Logik (Rohr-Geruest-Traeger, spaeter z.B.
|
|
;; Gattertraeger) - bewusst eine eigene Datei: eigener Dialog, Laenge aus der
|
|
;; Zeichnung, Streben/Muffe/Beschriftung statt Anbaugruppen/Konfigurationen.
|
|
(defun geruest-traeger-daten ( / )
|
|
(geruest-json-laden-cache "geruest_traeger.json" '*geruest-traeger-daten*)
|
|
)
|
|
|
|
;; Alle Baugruppen als ((id . objekt) ...) in Dateireihenfolge - diese
|
|
;; Reihenfolge bestimmt auch die Reihenfolge im Bereichs-Dropdown. Die
|
|
;; Traeger stehen in geruest_traeger.json und gehoeren nicht hierher.
|
|
(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))
|
|
)
|
|
|
|
;; Pfad der Dummy-DWG fuer den Block. Ein "dummy" in der Geometrie-Variante
|
|
;; wird bevorzugt; fehlt die Datei unter data/geruest, wird gemeldet und auf
|
|
;; den "dummy" der Baugruppe zurueckgefallen. Rueckgabe: (datei . pfad) -
|
|
;; pfad ist nil, wenn kein Datenverzeichnis bekannt ist; ob die
|
|
;; Rueckfall-Datei existiert, prueft der Aufrufer.
|
|
(defun geruest-dummy-wahl (variante bg / v pfad)
|
|
(setq v (if variante (ssg-json-get variante "dummy")))
|
|
(if (and v (= (type v) 'STR) (/= v "")
|
|
(setq pfad (geruest-dummy-pfad v))
|
|
(findfile pfad))
|
|
(cons v pfad)
|
|
(progn
|
|
(if (and v (= (type v) 'STR) (/= v ""))
|
|
(princ (ssg-textf "gr-fehler-dummy-variante"
|
|
(list (if pfad pfad v)
|
|
(if (ssg-json-get bg "dummy")
|
|
(ssg-json-get bg "dummy")
|
|
"-"))))
|
|
)
|
|
(setq v (ssg-json-get bg "dummy"))
|
|
(cons v (geruest-dummy-pfad v))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Liste ohne die Eintraege, die (ohne Gross/Klein) gleich pfad sind. Damit
|
|
;; landet eine Teile-DWG, die zugleich der Dummy ist, nicht doppelt im Block.
|
|
(defun geruest-ohne-pfad (pfad liste)
|
|
(if pfad
|
|
(vl-remove-if '(lambda (p) (= (strcase p) (strcase pfad))) liste)
|
|
liste
|
|
)
|
|
)
|
|
|
|
|
|
;; ============================================================
|
|
;; TEILE AUSWERTEN
|
|
;; ============================================================
|
|
|
|
;; 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")
|
|
)
|
|
)
|
|
|
|
;; Zwei Mengenfelder im JSON, bewusst verschieden benannt:
|
|
;; "stueckzahl" = wie oft das Teil TATSAECHLICH geschrieben wird - je
|
|
;; Einbau (Variante) bzw. je Satz/Anbauteil. Fehlt = 1.
|
|
;; "anzahl_vorgabe" = NUR die Vorbelegung des Anzahl-Feldes im Dialog
|
|
;; (Anbaugruppen). Fehlt = 1.
|
|
;; Ein Anbauteil wird Anzahl (Dialog) x stueckzahl mal geschrieben; bei einer
|
|
;; Gruppe ("teile") ist die Anzahl die Zahl der Saetze.
|
|
(defun geruest-positiv-int (w / )
|
|
(if (and w (numberp w) (> w 0)) (fix w) 1)
|
|
)
|
|
|
|
(defun geruest-stueckzahl (eintrag)
|
|
(geruest-positiv-int (ssg-json-get eintrag "stueckzahl"))
|
|
)
|
|
|
|
(defun geruest-anzahl-vorgabe (eintrag)
|
|
(geruest-positiv-int (ssg-json-get eintrag "anzahl_vorgabe"))
|
|
)
|
|
|
|
;; Sivas-ID als String. Im JSON stehen rein numerische IDs als Zahl
|
|
;; (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
|
|
;; "stueckzahl" wiederholt. Benannte Gruppen ("teile") werden rekursiv aufgeloest.
|
|
;; farbig = darf das Teil die Baugruppenfarbe tragen ("farbig" im JSON). Eine
|
|
;; Gruppe mit "farbig": true vererbt das an ihre Teile (erbe); ein Teil kann
|
|
;; die Vererbung nicht per false aufheben - false und "fehlt" sind beide nil.
|
|
;; 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-stueckzahl eintrag))))
|
|
)
|
|
erg
|
|
)
|
|
|
|
;; Alle Artikelnummern eines Eintrags, jede gemaess "stueckzahl" 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-anzahl-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 "")
|
|
)
|
|
)
|
|
|
|
;; Teile eines Anbauteils bei der im Dialog gewaehlten Anzahl: der Eintrag
|
|
;; (Einzelteil mit seiner "stueckzahl" bzw. benannte Gruppe als kompletter
|
|
;; Satz) anzahl-mal. Die Stueckzahlen INNERHALB eines Satzes bleiben erhalten
|
|
;; (ein Schraubenset bleibt 1 Scheibe + 2 Muttern + 1 Schraube je Satz).
|
|
(defun geruest-teile-paare-n (eintrag anzahl / einmal erg i)
|
|
(setq einmal (geruest-teile-paare eintrag nil))
|
|
(setq erg nil i 0)
|
|
(while (< i anzahl)
|
|
(setq erg (append erg einmal))
|
|
(setq i (1+ i))
|
|
)
|
|
erg
|
|
)
|
|
|
|
(defun geruest-artikelnummern-n (eintrag anzahl)
|
|
(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 Anzahl (Feld "anzahl"). Ein unbekannter Artikelname wird gemeldet und
|
|
;; uebersprungen, statt die ganze Konfiguration scheitern zu lassen.
|
|
(defun geruest-konfig-position (konfig schluessel anbauteile / mengen idx n)
|
|
(setq mengen (geruest-nil-liste (length anbauteile)))
|
|
(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 "anzahl"))
|
|
(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-anzahl-vorgabe a))))))
|
|
)
|
|
erg
|
|
)
|
|
|
|
;; Mengenliste (nil oder Zahl je Teil) in den Tile-Zustand umsetzen.
|
|
(defun geruest-anzahlen->tiles (mengen / erg i a)
|
|
(setq erg nil i 0)
|
|
(foreach m mengen
|
|
(setq a (nth i *geruest-anbauteile*))
|
|
(setq erg (append erg
|
|
(list (if m
|
|
(cons "1" (itoa m))
|
|
(cons "0" (itoa (geruest-anzahl-vorgabe 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)
|
|
)
|
|
|
|
;; Farbliste des Dialogs aus der TEILEFARBE-Definition aufbauen: Optionen +
|
|
;; freie Option ans Listenende; deren Index merkt sich der Callback, um das
|
|
;; Freitextfeld freizuschalten. Genutzt vom GERUEST- und vom Traeger-Dialog.
|
|
(defun geruest-farb-liste-setzen (farb-opts / frei-opt)
|
|
(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)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Gewaehlte Farbe als Text. idx-str = Tile-Wert der Farbliste,
|
|
;; frei = Inhalt des Freitextfelds.
|
|
(defun geruest-farbwert (idx-str frei / idx)
|
|
(setq idx (atoi idx-str))
|
|
(cond
|
|
((null *geruest-farb-liste*) "")
|
|
((= idx *geruest-frei-idx*) frei)
|
|
((nth idx *geruest-farb-liste*) (nth idx *geruest-farb-liste*))
|
|
(T "")
|
|
)
|
|
)
|
|
|
|
;; Aktuell gewaehlte Farbe des GERUEST-Dialogs als Text.
|
|
(defun geruest-dlg-farbwert ( / )
|
|
(geruest-farbwert *geruest-dlg-farbe* *geruest-dlg-frei*)
|
|
)
|
|
|
|
;; 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-anzahlen->tiles
|
|
(geruest-konfig-position k "oben" *geruest-anbauteile*)))
|
|
(setq *geruest-dlg-unten*
|
|
(geruest-anzahlen->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 . anzahl) ...)) oder nil bei ungueltigem Mengenfeld.
|
|
;; Das fuehrende T ist noetig, weil "nichts ausgewaehlt" ein gueltiges
|
|
;; Ergebnis ist und sich sonst nicht von einem Fehler unterscheiden liesse.
|
|
(defun geruest-anzahlen-lesen (zustand / erg i a m ok)
|
|
(setq erg nil i 0 ok T)
|
|
(foreach paar zustand
|
|
(setq a (nth i *geruest-anbauteile*))
|
|
(if (and ok (= (car paar) "1"))
|
|
(progn
|
|
(setq m (geruest-anzahl-wert (cdr paar) (geruest-anzahl-vorgabe 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-anzahl-wert (cdr paar) (geruest-anzahl-vorgabe a)))
|
|
(if m
|
|
(setq erg (append erg
|
|
(list (list (cons "artikel" (geruest-eintrag-name a))
|
|
(cons "anzahl" 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"))
|
|
"\", \"anzahl\": " (itoa (ssg-json-get e "anzahl")) " }"
|
|
(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 . anzahl) ...) ((idx . anzahl) ...) 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 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")))
|
|
|
|
(geruest-farb-liste-setzen farb-opts)
|
|
|
|
(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-anzahlen-lesen *geruest-dlg-oben*))
|
|
(setq unten-m (geruest-anzahlen-lesen *geruest-dlg-unten*))
|
|
(if (or (null oben-m) (null unten-m))
|
|
(alert (ssg-text "gr-alert-menge"))
|
|
(progn
|
|
(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
|
|
dummy-attribs attribs)
|
|
;; Eine Variante darf eine eigene Dummy-DWG mitbringen; sonst (oder wenn
|
|
;; deren Datei fehlt) gilt die der Baugruppe.
|
|
(setq datei (geruest-dummy-wahl variante bg))
|
|
(setq dummy (cdr datei)
|
|
datei (car datei))
|
|
;; Ist der Dummy zugleich eine Teile-DWG (z.B. 821006036.dwg beim
|
|
;; T-Abhaenger), nicht ein zweites Mal einfuegen.
|
|
(setq teile-dwgs (geruest-ohne-pfad dummy teile-dwgs))
|
|
(if (or (null dummy) (null (findfile dummy)))
|
|
(progn
|
|
(princ (ssg-textf "gr-fehler-dummy" (list (if dummy dummy datei))))
|
|
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*))
|
|
;; nil = Drehwinkel interaktiv am Cursor
|
|
(geruest-block-abschliessen bg attribs werte lastEnt pt nil)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Gemeinsamer Schluss aller Geruest-Bloecke: Werte ins Schema eintragen,
|
|
;; ATTDEFs erzeugen, alles Neue seit lastEnt zu GR_<id>_<ts> zusammenfassen
|
|
;; und bei pt einfuegen.
|
|
;; attribs = Schema-Alist (Tags + Vorgabewerte), werte = berechnete Werte
|
|
;; rot = Drehwinkel in Grad (Zahl) oder nil fuer interaktive Drehung.
|
|
;; Bei einer Zahl muss der Aufrufer ANGBASE/ANGDIR/AUNITS auf 0
|
|
;; gesetzt haben, sonst deutet INSERT den Wert anders.
|
|
;; Rueckgabe: (blockname . entity) oder nil.
|
|
(defun geruest-block-abschliessen (bg attribs werte lastEnt pt rot
|
|
/ e ss bname blockEnt)
|
|
(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 (Geometrie + 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))
|
|
(command "_.INSERT" bname pt 1 1 (if rot rot 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 . anzahl) ...).
|
|
(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"))
|
|
|
|
|
|
;; ============================================================
|
|
;; ROHR-GERUEST-TRAEGER (Daten: data/json/geruest_traeger.json)
|
|
;; ============================================================
|
|
;; Eigener Dialog (dcl/geruest_traeger.dcl): Variante, Farbe und zwei
|
|
;; Laengenabzuege. Die Laenge selbst wird DANACH in der Zeichnung bestimmt -
|
|
;; Startpunkt, dann Endpunkt oder getippte Laenge (+ Richtung), wie beim
|
|
;; Kreisel. Aktive Abzuege ruecken die Linie beidseitig ein: Strecke 1000,
|
|
;; Abzug Anfang 20, Ende 35 -> Linie beginnt 20 mm hinter dem Startklick und
|
|
;; ist 945 mm lang.
|
|
;;
|
|
;; Keine Dummy-DWG: die Geometrie ist eine einzige LINE, die je Block eine
|
|
;; andere Laenge hat. Sie entsteht per entmake von (0,0,0) nach (L,0,0) auf
|
|
;; dem Layer der Variante; der Block wird am eingerueckten Startpunkt mit dem
|
|
;; Richtungswinkel eingefuegt. Es wird wiederholt eingefuegt, bis der Nutzer
|
|
;; ESC/Enter drueckt - jeder Traeger ist ein eigener GR_Traeger_<ts>-Block.
|
|
|
|
;; Baugruppe ueber das ASCII-Feld "id" in daten (z.B. (geruest-traeger-daten)).
|
|
(defun geruest-baugruppe (id daten / erg)
|
|
(setq erg nil)
|
|
(foreach eintrag daten
|
|
(if (and (null erg) (listp (cdr eintrag))
|
|
(equal (ssg-json-get (cdr eintrag) "id") id))
|
|
(setq erg (cdr eintrag))
|
|
)
|
|
)
|
|
erg
|
|
)
|
|
|
|
;; Feld einer Attribut-Definition (attribute -> TAG -> feld). Eine Variante
|
|
;; darf einen eigenen "attribute"-Block mitbringen, der vor dem der Baugruppe
|
|
;; gilt (z.B. ein anderer Laengenabzug bei einer Muffen-Variante). assoc
|
|
;; statt ssg-json-get, damit ein in der Variante gesetztes false (= nil) den
|
|
;; Wert der Baugruppe ueberschreibt, statt als "fehlt" durchzufallen.
|
|
(defun geruest-attr-feld (variante bg tag feld)
|
|
(geruest-obj-feld variante bg (list "attribute" tag) feld)
|
|
)
|
|
|
|
;; Objekt unter einem Schluesselpfad, z.B. ("attribute" "LAENGE"); nil, wenn
|
|
;; ein Schluessel fehlt.
|
|
(defun geruest-json-pfad-get (obj pfad)
|
|
(foreach k pfad (setq obj (if (and obj (listp obj)) (ssg-json-get obj k))))
|
|
obj
|
|
)
|
|
|
|
;; Allgemeine Form von geruest-attr-feld: Feld unter pfad, Variante vor
|
|
;; Baugruppe, je FELD aufgeloest (eine Variante nennt nur, was abweicht).
|
|
;; Genutzt fuer "attribute" und "beschriftung".
|
|
(defun geruest-obj-feld (variante bg pfad feld / def paar)
|
|
(setq def (if variante (geruest-json-pfad-get variante pfad)))
|
|
(setq paar (if (and def (listp def)) (assoc feld def)))
|
|
(if paar
|
|
(cdr paar)
|
|
(ssg-json-get (geruest-json-pfad-get bg pfad) feld)
|
|
)
|
|
)
|
|
|
|
;; Millimeter-Eingabe als Zahl >= 0 (Komma wie Punkt), sonst nil.
|
|
;; Leere Eingabe -> nil.
|
|
(defun geruest-mm-zahl (s / w)
|
|
(setq s (vl-string-translate "," "." (ssg-cfg-trim (if s s ""))))
|
|
(if (and (/= s "") (setq w (distof s 2)) (>= w 0.0)) w)
|
|
)
|
|
|
|
;; Abzug-Feld: leer -> 0, gueltige Zahl -> Zahl, sonst nil.
|
|
(defun geruest-abzug-wert (s)
|
|
(if (= (ssg-cfg-trim (if s s "")) "")
|
|
0.0
|
|
(geruest-mm-zahl s)
|
|
)
|
|
)
|
|
|
|
;; Millimeterwert fuer Attribute/Meldungen: ganze Zahl ohne Nachkommastelle,
|
|
;; sonst eine Stelle.
|
|
(defun geruest-mm-string (w / r)
|
|
(setq r (fix (+ w 0.5)))
|
|
(if (equal w r 1e-6) (itoa r) (rtos w 2 1))
|
|
)
|
|
|
|
;; Netto-Laenge der Linie: Strecke minus beide Abzuege, nil wenn <= 0.
|
|
(defun geruest-traeger-laenge (strecke abzug-a abzug-e / netto)
|
|
(setq netto (- strecke (if abzug-a abzug-a 0.0) (if abzug-e abzug-e 0.0)))
|
|
(if (> netto 1e-6) netto)
|
|
)
|
|
|
|
;; Eingerueckter Startpunkt: abzug-a entlang winkel ab p1, Z von p1.
|
|
(defun geruest-traeger-start (p1 winkel abzug-a / p)
|
|
(setq p (polar p1 winkel (if abzug-a abzug-a 0.0)))
|
|
(list (car p) (cadr p) (if (caddr p1) (caddr p1) 0.0))
|
|
)
|
|
|
|
;; Abweichung eines Randes vom erlaubten Bereich [rand-min, rand-max]
|
|
;; (0 = innerhalb).
|
|
(defun geruest-rand-abweichung (r rand-min rand-max)
|
|
(cond ((< r rand-min) (- rand-min r))
|
|
((> r rand-max) (- r rand-max))
|
|
(T 0.0))
|
|
)
|
|
|
|
;; Querstreben-Plan: (rand positionen). Regel: der Abstand zwischen zwei
|
|
;; Streben ist IMMER genau abstand, beide Raender sind gleich:
|
|
;; netto = k * abstand + 2 * rand (k = Felder, k+1 Streben)
|
|
;; Gewaehlt wird das k, dessen Rand am naechsten am Bereich [rand-min,
|
|
;; rand-max] liegt (bei Gleichstand das mit weniger Streben). Weil der
|
|
;; Bereich schmaler ist als abstand, geht nicht jede Laenge auf: mit 500/
|
|
;; 100..250 liegt der Rand genau dann im Bereich, wenn netto mod 500 = 0 oder
|
|
;; in [200, 500) ist - bei 1001..1199 mm oder unter 200 mm z.B. nicht. Der Plan
|
|
;; wird dann trotzdem geliefert, die Pruefung (geruest-rand-abweichung) und
|
|
;; die Meldung uebernimmt der Aufrufer. netto <= 0 -> nil.
|
|
(defun geruest-traeger-streben-plan (netto abstand rand-min rand-max
|
|
/ k kmax r dev best-k best-r best-dev i erg)
|
|
(if (and netto (> netto 1e-6) abstand (> abstand 1e-6))
|
|
(progn
|
|
(setq kmax (fix (+ (/ netto abstand) 1e-9)) k 0 best-k nil)
|
|
(while (<= k kmax)
|
|
(setq r (/ (- netto (* k abstand)) 2.0))
|
|
(if (>= r -1e-9)
|
|
(progn
|
|
(setq dev (geruest-rand-abweichung r rand-min rand-max))
|
|
;; strikt kleiner: bei Gleichstand bleibt das kleinere k
|
|
(if (or (null best-k) (< dev (- best-dev 1e-6)))
|
|
(setq best-k k best-r (max r 0.0) best-dev dev))
|
|
)
|
|
)
|
|
(setq k (1+ k))
|
|
)
|
|
(setq erg nil i best-k)
|
|
(while (>= i 0)
|
|
(setq erg (cons (+ best-r (* i abstand)) erg))
|
|
(setq i (1- i))
|
|
)
|
|
(list best-r erg)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Rand des Streben-Plans gegen [rand-min, rand-max] pruefen und bei
|
|
;; Abweichung den Benutzer informieren (Messagebox, ohne GUI auf die
|
|
;; Konsole). strebe = Ergebnis von geruest-traeger-strebe-cfg.
|
|
;; Rueckgabe: T = Rand im Bereich.
|
|
(defun geruest-traeger-rand-pruefen (netto strebe / plan txt)
|
|
(setq plan (geruest-traeger-streben-plan netto (nth 3 strebe) (nth 4 strebe) (nth 5 strebe)))
|
|
(if (and plan
|
|
(> (geruest-rand-abweichung (car plan) (nth 4 strebe) (nth 5 strebe)) 1e-6))
|
|
(progn
|
|
(setq txt (ssg-textf "gr-tr-strebe-rand"
|
|
(list (geruest-mm-string netto)
|
|
(geruest-mm-string (car plan))
|
|
(geruest-mm-string (nth 4 strebe))
|
|
(geruest-mm-string (nth 5 strebe))
|
|
(geruest-mm-string (nth 3 strebe))
|
|
(itoa (length (cadr plan))))))
|
|
(if (ssg-gui-p) (alert txt) (princ (strcat "\n" txt)))
|
|
nil
|
|
)
|
|
T
|
|
)
|
|
)
|
|
|
|
;; Nur die Positionen der Querstreben (Abstand ab Linienanfang).
|
|
(defun geruest-traeger-streben (netto abstand rand-min rand-max)
|
|
(cadr (geruest-traeger-streben-plan netto abstand rand-min rand-max))
|
|
)
|
|
|
|
;; Querstreben-Konfiguration (Variante vor Baugruppe) als
|
|
;; (dummy laenge querlinie abstand rand-min rand-max) oder nil, wenn keine
|
|
;; "querstrebe" definiert ist.
|
|
;; dummy = DWG unter data/geruest (Basispunkt Strebenmitte, 30 mm laengs
|
|
;; X) oder nil
|
|
;; laenge/querlinie = nur fuer den Rueckfall ohne Dummy-DWG: zwei Querlinien
|
|
;; im Abstand laenge, je querlinie lang
|
|
;; Fehlende Zahlenwerte -> Standard 30/25/500/100/250.
|
|
(defun geruest-traeger-strebe-cfg (variante bg / q w d)
|
|
(setq q (geruest-variante-wert variante bg "querstrebe"))
|
|
(if (and q (listp q))
|
|
(progn
|
|
(setq d (ssg-json-get q "dummy"))
|
|
(cons (if (and d (= (type d) 'STR) (/= d "")) d)
|
|
(mapcar '(lambda (feld std)
|
|
(setq w (ssg-json-get q feld))
|
|
(if (numberp w) (float w) std))
|
|
'("laenge" "querlinie" "abstand" "rand_min" "rand_max")
|
|
'(30.0 25.0 500.0 100.0 250.0)))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Muffen-Dummy einer Variante: nur bei "mit_muffe": true die "dummy"-Datei
|
|
;; aus "muffe" (Variante vor Baugruppe), sonst nil. Das Flag steht bewusst
|
|
;; ausdruecklich je Variante, statt aus dem Namen ("mit Muffe") geraten zu
|
|
;; werden. Bei "mit 2 Muffen" wird trotzdem nur eine Muffe gezeichnet.
|
|
(defun geruest-traeger-muffe-dummy (variante bg / m d)
|
|
(if (and variante (ssg-json-get variante "mit_muffe"))
|
|
(progn
|
|
(setq m (geruest-variante-wert variante bg "muffe"))
|
|
(setq d (if (and m (listp m)) (ssg-json-get m "dummy")))
|
|
(if (and d (= (type d) 'STR) (/= d "")) d)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Liegt netto in [min-l, max-l]? Fehlende Grenzen gelten nicht.
|
|
(defun geruest-traeger-pruefen (netto min-l max-l)
|
|
(and netto
|
|
(or (null min-l) (>= netto min-l))
|
|
(or (null max-l) (<= netto max-l)))
|
|
)
|
|
|
|
;; BEZEICHNUNG: Teileart + Variante + aktive Abzuege, mit " + " verkettet
|
|
;; (Artikelnamen enthalten Kommas, siehe geruest-einfuegen).
|
|
(defun geruest-traeger-bezeichnung (teileart variante-name abzug-a abzug-e / teile)
|
|
(setq teile (list teileart variante-name))
|
|
(if (> abzug-a 0.0)
|
|
(setq teile (append teile (list (ssg-textf "gr-tr-bez-abzug-anfang"
|
|
(list (geruest-mm-string abzug-a)))))))
|
|
(if (> abzug-e 0.0)
|
|
(setq teile (append teile (list (ssg-textf "gr-tr-bez-abzug-ende"
|
|
(list (geruest-mm-string abzug-e)))))))
|
|
(ssg-join teile " + ")
|
|
)
|
|
|
|
(defun geruest-traeger-dcl-pfad ( / basis)
|
|
(setq basis (cond ((getenv "DXFM_DCL"))
|
|
((getenv "DXFMAKRO") (strcat (getenv "DXFMAKRO") "/dcl"))))
|
|
(if basis
|
|
(strcat (vl-string-translate "\\" "/" basis) "/geruest_traeger.dcl")
|
|
)
|
|
)
|
|
|
|
;; --- Dialogzustand (Globals, siehe Abschnitt DIALOGZUSTAND oben) ---
|
|
;; Bleibt zwischen zwei GERUEST_TRAEGER-Aufrufen erhalten.
|
|
|
|
;; Abzug-Vorgaben (aktiv + Wert) der Variante idx in den Zustand laden.
|
|
(defun geruest-tr-vorgaben-laden (idx / v)
|
|
(setq v (nth idx (ssg-json-get *geruest-tr-bg* "geometrie_varianten")))
|
|
(setq *geruest-tr-abzug-a*
|
|
(if (geruest-attr-feld v *geruest-tr-bg* "LAENGENABZUGANFANG" "aktiv") "1" "0"))
|
|
(setq *geruest-tr-abzug-a-w*
|
|
(geruest-zahl-string (geruest-attr-feld v *geruest-tr-bg* "LAENGENABZUGANFANG" "vorgabe")))
|
|
(setq *geruest-tr-abzug-e*
|
|
(if (geruest-attr-feld v *geruest-tr-bg* "LAENGENABZUGENDE" "aktiv") "1" "0"))
|
|
(setq *geruest-tr-abzug-e-w*
|
|
(geruest-zahl-string (geruest-attr-feld v *geruest-tr-bg* "LAENGENABZUGENDE" "vorgabe")))
|
|
)
|
|
|
|
(defun geruest-tr-abzug-schreiben ( / )
|
|
(set_tile "abzug_a" *geruest-tr-abzug-a*)
|
|
(set_tile "abzug_a_w" *geruest-tr-abzug-a-w*)
|
|
(set_tile "abzug_e" *geruest-tr-abzug-e*)
|
|
(set_tile "abzug_e_w" *geruest-tr-abzug-e-w*)
|
|
(mode_tile "abzug_a_w" (if (= *geruest-tr-abzug-a* "1") 0 1))
|
|
(mode_tile "abzug_e_w" (if (= *geruest-tr-abzug-e* "1") 0 1))
|
|
)
|
|
|
|
;; Variantenwechsel im Dialog: Abzug-Vorgaben der neuen Variante uebernehmen.
|
|
(defun geruest-tr-variante-gewaehlt (wert / )
|
|
(setq *geruest-tr-variante* wert)
|
|
(geruest-tr-vorgaben-laden (atoi wert))
|
|
(geruest-tr-abzug-schreiben)
|
|
)
|
|
|
|
(defun geruest-tr-dlg-lesen ( / )
|
|
(setq *geruest-tr-variante* (get_tile "variante"))
|
|
(setq *geruest-tr-farbe* (get_tile "farbe"))
|
|
(setq *geruest-tr-frei* (get_tile "farbe_frei"))
|
|
(setq *geruest-tr-abzug-a* (get_tile "abzug_a"))
|
|
(setq *geruest-tr-abzug-a-w* (get_tile "abzug_a_w"))
|
|
(setq *geruest-tr-abzug-e* (get_tile "abzug_e"))
|
|
(setq *geruest-tr-abzug-e-w* (get_tile "abzug_e_w"))
|
|
(setq *geruest-tr-beschriftung* (get_tile "beschriftung"))
|
|
)
|
|
|
|
;; Wert eines Abzugs aus dem Zustand: inaktiv -> 0, aktiv -> Zahl oder nil.
|
|
(defun geruest-tr-abzug (aktiv wert)
|
|
(if (= aktiv "1") (geruest-abzug-wert wert) 0.0)
|
|
)
|
|
|
|
;; Traeger-Dialog. Rueckgabe:
|
|
;; (variante-index farbe abzug-anfang abzug-ende beschriften-p) oder nil bei
|
|
;; Abbruch.
|
|
(defun geruest-traeger-dialog (bg / varianten dcl-pfad dat fertig rueckgabe
|
|
ergebnis aw ew)
|
|
(setq varianten (ssg-json-get bg "geometrie_varianten"))
|
|
(setq *geruest-tr-bg* bg)
|
|
(geruest-farb-liste-setzen
|
|
(ssg-json-get (ssg-json-get bg "attribute") "TEILEFARBE"))
|
|
;; Ausgangszustand beim ersten Aufruf bzw. wenn der gemerkte Index nach
|
|
;; einer JSON-Aenderung nicht mehr passt.
|
|
(if (or (null *geruest-tr-variante*)
|
|
(>= (atoi *geruest-tr-variante*) (length varianten)))
|
|
(progn
|
|
(setq *geruest-tr-variante* "0" *geruest-tr-farbe* "0" *geruest-tr-frei* "")
|
|
(geruest-tr-vorgaben-laden 0)
|
|
)
|
|
)
|
|
;; Beschriftung standardmaessig an; der Haken bleibt zwischen Aufrufen
|
|
(if (null *geruest-tr-beschriftung*) (setq *geruest-tr-beschriftung* "1"))
|
|
(setq dcl-pfad (geruest-traeger-dcl-pfad))
|
|
(setq fertig nil rueckgabe nil)
|
|
|
|
;; Schleife: ungueltige Eingaben zeigen den Dialog mit dem bisherigen
|
|
;; Stand erneut - DCL kann Zahlen nicht selbst pruefen.
|
|
(while (not fertig)
|
|
(setq dat (if (and dcl-pfad (findfile dcl-pfad)) (load_dialog dcl-pfad) -1))
|
|
(if (or (< dat 0) (not (new_dialog "geruest_traeger" dat)))
|
|
(progn
|
|
(alert (ssg-textf "gr-tr-fehler-dcl"
|
|
(list (if dcl-pfad dcl-pfad "geruest_traeger.dcl"))))
|
|
(setq fertig T)
|
|
)
|
|
(progn
|
|
(start_list "variante")
|
|
(foreach v varianten (add_list (geruest-eintrag-name v)))
|
|
(end_list)
|
|
(set_tile "variante" *geruest-tr-variante*)
|
|
|
|
(if *geruest-farb-liste*
|
|
(progn
|
|
(start_list "farbe")
|
|
(foreach f *geruest-farb-liste* (add_list f))
|
|
(end_list)
|
|
(set_tile "farbe" *geruest-tr-farbe*)
|
|
(mode_tile "farbe_frei"
|
|
(if (= (atoi *geruest-tr-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)
|
|
)
|
|
)
|
|
(set_tile "farbe_frei" *geruest-tr-frei*)
|
|
(geruest-tr-abzug-schreiben)
|
|
(set_tile "beschriftung" *geruest-tr-beschriftung*)
|
|
(set_tile "hinweis" (ssg-text "gr-tr-hinweis"))
|
|
|
|
(action_tile "variante" "(geruest-tr-variante-gewaehlt $value)")
|
|
(action_tile "abzug_a"
|
|
"(mode_tile \"abzug_a_w\" (if (= $value \"1\") 0 1))")
|
|
(action_tile "abzug_e"
|
|
"(mode_tile \"abzug_e_w\" (if (= $value \"1\") 0 1))")
|
|
(action_tile "accept" "(geruest-tr-dlg-lesen) (done_dialog 1)")
|
|
(action_tile "cancel" "(done_dialog 0)")
|
|
(setq ergebnis (start_dialog))
|
|
(unload_dialog dat)
|
|
|
|
(cond
|
|
((= ergebnis 0) (setq fertig T))
|
|
((or (null (setq aw (geruest-tr-abzug *geruest-tr-abzug-a* *geruest-tr-abzug-a-w*)))
|
|
(null (setq ew (geruest-tr-abzug *geruest-tr-abzug-e* *geruest-tr-abzug-e-w*))))
|
|
(alert (ssg-text "gr-tr-alert-abzug"))
|
|
)
|
|
(T
|
|
(setq rueckgabe
|
|
(list (atoi *geruest-tr-variante*)
|
|
(geruest-farbwert *geruest-tr-farbe* *geruest-tr-frei*)
|
|
aw ew
|
|
(= *geruest-tr-beschriftung* "1")))
|
|
(setq fertig T)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
rueckgabe
|
|
)
|
|
|
|
;; X-Positionen der beiden Querlinien einer Strebe: Anfang und Ende des
|
|
;; Flacheisens, laenge mittig um die Strebenposition x.
|
|
(defun geruest-traeger-strebe-enden (x laenge)
|
|
(list (- x (/ laenge 2.0)) (+ x (/ laenge 2.0)))
|
|
)
|
|
|
|
;; Querstrebe darstellen: an Anfang und Ende je eine Linie quer zum Traeger
|
|
;; (Laenge querlinie, mittig auf der Traegerlinie y = 0).
|
|
(defun geruest-traeger-strebe-zeichnen (x laenge querlinie lay / hq)
|
|
(setq hq (/ querlinie 2.0))
|
|
(foreach xe (geruest-traeger-strebe-enden x laenge)
|
|
(entmake (list '(0 . "LINE") (cons 8 lay)
|
|
(list 10 xe (- hq) 0.0) (list 11 xe hq 0.0)))
|
|
)
|
|
)
|
|
|
|
;; Vollstaendiger Pfad einer Dummy-DWG unter data/geruest oder nil (mit
|
|
;; Meldung), wenn sie fehlt. datei = nil -> stilles nil (nichts konfiguriert).
|
|
(defun geruest-dummy-finden (datei / pfad)
|
|
(if datei
|
|
(progn
|
|
(setq pfad (geruest-dummy-pfad datei))
|
|
(if (and pfad (findfile pfad))
|
|
pfad
|
|
(progn
|
|
(princ (ssg-textf "gr-fehler-dummy" (list (if pfad pfad datei))))
|
|
nil
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Dummy-DWG als verschachtelten Block bei pt (Drehung 0) einfuegen. Ist die
|
|
;; Blockdefinition (Dateiname ohne .dwg) schon in der Zeichnung, wird per
|
|
;; Blockname eingefuegt - sonst wuerde die DWG bei jeder Strebe neu gelesen
|
|
;; (und ggf. "Block neu definieren?" gefragt). ATTREQ/ATTDIA muss der Aufrufer
|
|
;; auf 0 gesetzt haben.
|
|
(defun geruest-dummy-einfuegen (pfad pt / bname)
|
|
(setq bname (vl-filename-base pfad))
|
|
(command "_.INSERT" (if (tblsearch "BLOCK" bname) bname pfad) pt 1 1 0)
|
|
)
|
|
|
|
;; Linie + Querstreben + Muffe + ATTDEFs zu einem Block zusammenfassen und am
|
|
;; Startpunkt mit dem Richtungswinkel einfuegen. Im Block laeuft der Traeger
|
|
;; entlang +X, die Dummys werden darum ohne Drehung eingefuegt.
|
|
;; strebe = Ergebnis von geruest-traeger-strebe-cfg (nil = keine Streben)
|
|
;; strebe-pfad = Pfad der Strebe-DWG oder nil -> Rueckfall auf Querlinien
|
|
;; muffe-pfad = Pfad der Muffen-DWG oder nil -> keine Muffe; sonst eine
|
|
;; Muffe (Basispunkt Muffenmitte) am Linienende
|
|
;; Der Aufrufer sichert die Systemvariablen per ssg-start.
|
|
;; Rueckgabe: (blockname . entity) oder nil.
|
|
(defun geruest-traeger-block-bauen (bg layer netto strebe strebe-pfad muffe-pfad
|
|
werte pt winkel / lastEnt lay)
|
|
(setvar "ATTREQ" 0)
|
|
(setvar "ATTDIA" 0)
|
|
(setvar "OSMODE" 0)
|
|
;; Drehwinkel wird als Grad an INSERT uebergeben - nur eindeutig mit
|
|
;; Winkel-Nullrichtung Ost, gegen den Uhrzeigersinn, Einheit Grad.
|
|
(setvar "ANGBASE" 0.0)
|
|
(setvar "ANGDIR" 0)
|
|
(setvar "AUNITS" 0)
|
|
;; Nicht (entlast) - siehe geruest-block-bauen.
|
|
(setq lastEnt (ssg-lastent-ohne-attribute))
|
|
|
|
(setq lay (if (and layer (/= layer "")) layer "0"))
|
|
;; Aktiv setzen, damit auch die verschachtelten Dummy-INSERTs auf dem
|
|
;; Traeger-Layer landen (CLAYER sichert ssg-start immer mit).
|
|
(ssg-make-layer lay (ssg-layer-farbe-fuer-name lay) T)
|
|
(entmake (list '(0 . "LINE") (cons 8 lay)
|
|
'(10 0.0 0.0 0.0) (list 11 netto 0.0 0.0)))
|
|
;; strebe = (dummy laenge querlinie abstand rand-min rand-max)
|
|
(if strebe
|
|
(foreach x (geruest-traeger-streben netto (nth 3 strebe) (nth 4 strebe) (nth 5 strebe))
|
|
(if strebe-pfad
|
|
(geruest-dummy-einfuegen strebe-pfad (list x 0.0 0.0))
|
|
(geruest-traeger-strebe-zeichnen x (nth 1 strebe) (nth 2 strebe) lay)
|
|
)
|
|
)
|
|
)
|
|
(if muffe-pfad
|
|
(geruest-dummy-einfuegen muffe-pfad (list netto 0.0 0.0))
|
|
)
|
|
|
|
(geruest-block-abschliessen bg
|
|
(ssg-attrib-merge nil *geruest-traeger-attrib-defs*)
|
|
werte lastEnt pt (* winkel (/ 180.0 pi)))
|
|
)
|
|
|
|
;; Einfuege-Schleife: Startpunkt, Endpunkt oder Laenge, bis ESC/Enter.
|
|
;; wahl = Rueckgabe von geruest-traeger-dialog.
|
|
(defun geruest-traeger-einfuegen (bg wahl / variante teileart layer paare farbe
|
|
abzug-a abzug-e min-l max-l bez werte-basis
|
|
werte weiter p1 eingabe strecke winkel netto
|
|
ergebnis anzahl strebe strebe-pfad muffe-pfad
|
|
beschriften)
|
|
(setq variante (nth (car wahl) (ssg-json-get bg "geometrie_varianten")))
|
|
(setq farbe (cadr wahl)
|
|
abzug-a (caddr wahl)
|
|
abzug-e (cadddr wahl)
|
|
beschriften (nth 4 wahl))
|
|
(setq *geruest-beschr-gemeldet* nil)
|
|
(setq teileart (geruest-variante-wert variante bg "teileart"))
|
|
(setq layer (geruest-variante-wert variante bg "layer"))
|
|
(setq min-l (geruest-attr-feld variante bg "LAENGE" "min"))
|
|
(setq max-l (geruest-attr-feld variante bg "LAENGE" "max"))
|
|
(setq paare (geruest-teile-paare variante nil))
|
|
(setq strebe (geruest-traeger-strebe-cfg variante bg))
|
|
;; DWGs einmal je Durchgang aufloesen - eine fehlende Datei wird so nur
|
|
;; einmal gemeldet, nicht bei jedem Traeger. Fehlt die Strebe-DWG, werden
|
|
;; stattdessen Querlinien gezeichnet; fehlt die Muffe, entfaellt sie.
|
|
(setq strebe-pfad (if strebe (geruest-dummy-finden (car strebe))))
|
|
(setq muffe-pfad (geruest-dummy-finden (geruest-traeger-muffe-dummy variante bg)))
|
|
(setq bez (geruest-traeger-bezeichnung teileart
|
|
(geruest-eintrag-name variante) abzug-a abzug-e))
|
|
|
|
;; Fuer alle Traeger dieses Durchgangs gleich - nur LAENGE aendert sich.
|
|
(setq werte-basis
|
|
(list (cons "ARTINR" (ssg-join (mapcar 'car paare) ","))
|
|
(cons "BEZEICHNUNG" bez)
|
|
(cons "TEILEART" teileart)
|
|
(cons "LAENGENABZUGANFANG" (geruest-mm-string abzug-a))
|
|
(cons "LAENGENABZUGENDE" (geruest-mm-string abzug-e))
|
|
;; Block selbstbeschreibend - die Beschriftung (auch spaeter per
|
|
;; GERUEST_TRAEGER_BESCHRIFTEN) findet darueber ihre Formatierung
|
|
(cons "VARIANTE" (geruest-eintrag-name variante))))
|
|
(if (and layer (/= layer ""))
|
|
(setq werte-basis (append werte-basis (list (cons "LAYER" layer)))))
|
|
(if (/= farbe "")
|
|
(setq werte-basis (append werte-basis (list (cons "TEILEFARBE"
|
|
(ssg-join (geruest-farbliste paare farbe) ","))))))
|
|
|
|
(setq weiter T anzahl 0)
|
|
(while weiter
|
|
(setq strecke nil)
|
|
(setq p1 (getpoint (ssg-text "gr-tr-prompt-start")))
|
|
(if (null p1)
|
|
(setq weiter nil)
|
|
(progn
|
|
;; 128 = beliebige Eingabe: ein Punkt liefert Laenge UND Richtung,
|
|
;; eine getippte Zahl nur die Laenge (Richtung wird nachgefragt).
|
|
(initget 128)
|
|
(setq eingabe (getpoint p1 (ssg-text "gr-tr-prompt-ende")))
|
|
;; Reihenfolge wichtig: nil ist auch listp, und "" darf erst nach dem
|
|
;; Punkt-Fall verglichen werden.
|
|
(cond
|
|
((null eingabe) (setq weiter nil))
|
|
((listp eingabe)
|
|
;; Laenge in der XY-Ebene, die Linie liegt auf Z des Startpunkts
|
|
(setq strecke (distance (list (car p1) (cadr p1))
|
|
(list (car eingabe) (cadr eingabe))))
|
|
(setq winkel (angle p1 eingabe))
|
|
)
|
|
((= eingabe "") (setq weiter nil))
|
|
((setq strecke (geruest-mm-zahl eingabe))
|
|
(setq winkel (getangle p1 (ssg-text "gr-tr-prompt-richtung")))
|
|
(if (null winkel) (setq winkel 0.0))
|
|
)
|
|
(T (princ (ssg-textf "gr-tr-eingabe-ungueltig" (list eingabe))))
|
|
)
|
|
)
|
|
)
|
|
|
|
(if (and weiter strecke)
|
|
(progn
|
|
(setq netto (geruest-traeger-laenge strecke abzug-a abzug-e))
|
|
(cond
|
|
((null netto)
|
|
(princ (ssg-textf "gr-tr-laenge-null"
|
|
(list (geruest-mm-string strecke)
|
|
(geruest-mm-string (+ abzug-a abzug-e))))))
|
|
((not (geruest-traeger-pruefen netto min-l max-l))
|
|
(princ (ssg-textf "gr-tr-laenge-bereich"
|
|
(list (geruest-mm-string netto)
|
|
(if min-l (geruest-mm-string min-l) "0")
|
|
(if max-l (geruest-mm-string max-l) "-")))))
|
|
(T
|
|
;; Streben-Rand ausserhalb der Grenzen: informieren, aber trotzdem
|
|
;; einfuegen (der Abstand zwischen den Streben bleibt immer exakt)
|
|
(if strebe (geruest-traeger-rand-pruefen netto strebe))
|
|
(setq werte (cons (cons "LAENGE" (geruest-mm-string netto)) werte-basis))
|
|
(ssg-start nil '(("OSMODE") ("ATTREQ") ("ATTDIA")
|
|
("ANGBASE") ("ANGDIR") ("AUNITS")))
|
|
(setq ergebnis (geruest-traeger-block-bauen bg layer netto strebe
|
|
strebe-pfad muffe-pfad werte
|
|
(geruest-traeger-start p1 winkel abzug-a) winkel))
|
|
;; Beschriftung aus dem fertigen Block ableiten (dieselbe Funktion
|
|
;; wie GERUEST_TRAEGER_BESCHRIFTEN)
|
|
(if (and ergebnis beschriften)
|
|
(geruest-traeger-beschriften (cdr ergebnis)))
|
|
(ssg-end)
|
|
(if ergebnis
|
|
(progn
|
|
(setq anzahl (1+ anzahl))
|
|
(princ (ssg-textf "gr-tr-fertig"
|
|
(list (geruest-mm-string netto) (car ergebnis))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(princ (ssg-textf "gr-tr-ende" (list (itoa anzahl))))
|
|
(princ)
|
|
)
|
|
|
|
;; ============================================================
|
|
;; TRAEGER-BESCHRIFTUNG
|
|
;; ============================================================
|
|
;; Eigenes TEXT-Objekt neben dem Block, z.B. "RT 80/80 L=2650". Es wird
|
|
;; AUSSCHLIESSLICH aus dem fertigen Block abgeleitet (Einfuegepunkt, Drehung,
|
|
;; Attribute LAENGE und VARIANTE) - darum nutzen das Einfuegen und
|
|
;; GERUEST_TRAEGER_BESCHRIFTEN dieselbe Funktion, und ein von Hand
|
|
;; verschobener/gedrehter Traeger wird beim Neubeschriften korrekt erfasst.
|
|
;; Der Text traegt per XDATA (*geruest-beschr-app*, 1005) den Handle seines
|
|
;; Blocks; so wird er beim Neubeschriften ersetzt statt verdoppelt.
|
|
;;
|
|
;; Formatierung aus geruest.json, "beschriftung" (Variante vor Baugruppe, je
|
|
;; Feld): NUR stil, ausrichtung, hoehe - alles andere regelt der Textstil
|
|
;; ausserhalb (es wird kein Stil angelegt). Dazu Inhalt (format/text) und
|
|
;; Layer.
|
|
|
|
;; Winkel auf [0, 2pi) normieren.
|
|
(defun geruest-winkel-norm (w)
|
|
(setq w (rem w (* 2.0 pi)))
|
|
(if (< w 0.0) (+ w (* 2.0 pi)) w)
|
|
)
|
|
|
|
;; Textwinkel entlang des Traegers nach DIN-Konvention (lesbar von unten und
|
|
;; von rechts): fuer 90 < w <= 270 Grad um 180 Grad gedreht, sonst w.
|
|
(defun geruest-text-winkel (w / e)
|
|
(setq w (geruest-winkel-norm w) e 1e-9)
|
|
(if (and (> w (+ (/ pi 2.0) e)) (<= w (+ (* 1.5 pi) e)))
|
|
(geruest-winkel-norm (+ w pi))
|
|
w
|
|
)
|
|
)
|
|
|
|
;; Ausrichtungs-Code wie bei TEXT "Ausrichten" (T/M/B + L/C/R, z.B. "BC") ->
|
|
;; (dxf72 dxf73), nil bei unbekanntem Code.
|
|
(defun geruest-ausrichtung-codes (code / h v)
|
|
(if (and code (= (type code) 'STR) (= (strlen code) 2))
|
|
(progn
|
|
(setq code (strcase code))
|
|
(setq v (cdr (assoc (substr code 1 1) '(("T" . 3) ("M" . 2) ("B" . 1)))))
|
|
(setq h (cdr (assoc (substr code 2 1) '(("L" . 0) ("C" . 1) ("R" . 2)))))
|
|
(if (and v h) (list h v))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Lage des Textes: (punkt textwinkel dxf72 dxf73). p0 = Traeger-Startpunkt,
|
|
;; w = Traegerwinkel, laenge = Traegerlaenge. Der Bezugspunkt liegt auf der
|
|
;; Linie: L = in Leserichtung linkes Ende, C = Mitte, R = rechtes Ende. Nach
|
|
;; einer 180-Grad-Drehung ist "links" also das Linienende. Unbekannter Code
|
|
;; -> BC (die Meldung gibt der Aufrufer aus).
|
|
(defun geruest-traeger-text-lage (p0 w laenge code / codes tw p1 links rechts pt)
|
|
(setq codes (geruest-ausrichtung-codes code))
|
|
(if (null codes) (setq codes '(1 1)))
|
|
(setq tw (geruest-text-winkel w))
|
|
(setq p1 (polar p0 w laenge))
|
|
;; Projektion auf die Leserichtung entscheidet, welches Ende links liegt
|
|
(if (<= (+ (* (car p0) (cos tw)) (* (cadr p0) (sin tw)))
|
|
(+ (* (car p1) (cos tw)) (* (cadr p1) (sin tw))))
|
|
(setq links p0 rechts p1)
|
|
(setq links p1 rechts p0)
|
|
)
|
|
(setq pt (cond ((= (car codes) 0) links)
|
|
((= (car codes) 2) rechts)
|
|
(T (polar p0 w (/ laenge 2.0)))))
|
|
(list pt tw (car codes) (cadr codes))
|
|
)
|
|
|
|
;; Alle Vorkommen von alt in s durch neu ersetzen.
|
|
(defun geruest-string-ersetzen (s alt neu / pos)
|
|
(setq pos (vl-string-search alt s))
|
|
(while pos
|
|
(setq s (strcat (substr s 1 pos) neu (substr s (+ pos (strlen alt) 1))))
|
|
(setq pos (vl-string-search alt s (+ pos (strlen neu))))
|
|
)
|
|
s
|
|
)
|
|
|
|
;; Beschriftungstext: %1 = Text der Variante, %2 = Laenge auf ganze mm.
|
|
(defun geruest-traeger-text-string (fmt txt laenge)
|
|
(geruest-string-ersetzen
|
|
(geruest-string-ersetzen fmt "%1" txt)
|
|
"%2" (itoa (fix (+ laenge 0.5))))
|
|
)
|
|
|
|
;; Beschriftungs-Konfiguration als Alist (format text stil ausrichtung hoehe
|
|
;; layer), je Feld Variante vor Baugruppe vor Code-Standard. Fehlt "text",
|
|
;; gilt der Variantenname bzw. ersatz-text (Block ohne bekannte Variante).
|
|
;; stil/layer = nil -> aktueller Textstil/Layer.
|
|
(defun geruest-traeger-beschr-cfg (variante bg ersatz-text / txt h)
|
|
(setq txt (geruest-beschr-feld variante bg "text"))
|
|
(if (not (and txt (= (type txt) 'STR) (/= txt "")))
|
|
(setq txt (if variante (geruest-eintrag-name variante) ersatz-text)))
|
|
(setq h (geruest-beschr-feld variante bg "hoehe"))
|
|
(list (cons "format" (cond ((geruest-beschr-feld variante bg "format")) ("%1 L=%2")))
|
|
(cons "text" (if txt txt ""))
|
|
(cons "stil" (geruest-beschr-feld variante bg "stil"))
|
|
(cons "ausrichtung" (cond ((geruest-beschr-feld variante bg "ausrichtung")) ("BC")))
|
|
(cons "hoehe" (if (numberp h) (float h) 50.0))
|
|
(cons "layer" (geruest-beschr-feld variante bg "layer")))
|
|
)
|
|
|
|
(defun geruest-beschr-feld (variante bg feld)
|
|
(geruest-obj-feld variante bg '("beschriftung") feld)
|
|
)
|
|
|
|
;; Handle des Traeger-Blocks aus der XDATA einer Beschriftung (oder nil).
|
|
(defun geruest-beschr-handle (ent / xd)
|
|
(setq xd (cadr (assoc -3 (entget ent (list *geruest-beschr-app*)))))
|
|
(if xd (cdr (assoc 1005 (cdr xd))))
|
|
)
|
|
|
|
;; Alle Beschriftungen der Zeichnung (Auswahlsatz oder nil).
|
|
(defun geruest-beschr-alle ( / )
|
|
(ssget "_X" (list '(0 . "TEXT") (list -3 (list *geruest-beschr-app*))))
|
|
)
|
|
|
|
;; Beschriftung(en) zu einem Block-Handle loeschen.
|
|
(defun geruest-beschr-entfernen (handle / ss i e)
|
|
(if (and handle (setq ss (geruest-beschr-alle)))
|
|
(progn
|
|
(setq i 0)
|
|
(repeat (sslength ss)
|
|
(setq e (ssname ss i))
|
|
(if (equal (geruest-beschr-handle e) handle) (entdel e))
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Textstil pruefen: vorhanden -> Name, sonst einmal je Lauf melden und den
|
|
;; aktuellen TEXTSTYLE nehmen. *geruest-beschr-gemeldet* setzt der Aufrufer
|
|
;; je Lauf zurueck.
|
|
(defun geruest-beschr-stil (stil / )
|
|
(cond
|
|
((and stil (/= stil "") (tblsearch "STYLE" stil)) stil)
|
|
(T
|
|
(if (and stil (/= stil "") (not (member stil *geruest-beschr-gemeldet*)))
|
|
(progn
|
|
(princ (ssg-textf "gr-tr-beschr-stil-fehlt" (list stil (getvar "TEXTSTYLE"))))
|
|
(setq *geruest-beschr-gemeldet* (cons stil *geruest-beschr-gemeldet*))
|
|
)
|
|
)
|
|
(getvar "TEXTSTYLE")
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Einen Traeger-Block beschriften (eine evtl. vorhandene Beschriftung wird
|
|
;; ersetzt). Rueckgabe: "ok", "ersatz" (Block ohne bekannte VARIANTE, mit den
|
|
;; Vorgaben der Baugruppe beschriftet) oder nil (nicht beschriftbar).
|
|
(defun geruest-traeger-beschriften (blockEnt / ed attribs bg vname idx variante
|
|
cfg laenge lage lay handle code erg)
|
|
(setq ed (entget blockEnt))
|
|
(setq attribs (ssg-attrib-read blockEnt))
|
|
(setq bg (geruest-baugruppe "Traeger" (geruest-traeger-daten)))
|
|
(setq laenge (atof (cond ((cdr (assoc "LAENGE" attribs))) ("0"))))
|
|
(if (and bg (> laenge 0.0))
|
|
(progn
|
|
(setq vname (cdr (assoc "VARIANTE" attribs)))
|
|
(setq idx (if (and vname (/= vname ""))
|
|
(geruest-name-index vname (ssg-json-get bg "geometrie_varianten"))))
|
|
(setq variante (if idx (nth idx (ssg-json-get bg "geometrie_varianten"))))
|
|
(setq cfg (geruest-traeger-beschr-cfg variante bg
|
|
(cond ((cdr (assoc "TEILEART" attribs))) (""))))
|
|
(setq code (cdr (assoc "ausrichtung" cfg)))
|
|
(if (and (null (geruest-ausrichtung-codes code))
|
|
(not (member code *geruest-beschr-gemeldet*)))
|
|
(progn
|
|
(princ (ssg-textf "gr-tr-beschr-ausrichtung" (list code)))
|
|
(setq *geruest-beschr-gemeldet* (cons code *geruest-beschr-gemeldet*))
|
|
)
|
|
)
|
|
(setq lage (geruest-traeger-text-lage (cdr (assoc 10 ed)) (cdr (assoc 50 ed))
|
|
laenge code))
|
|
(setq lay (cdr (assoc "layer" cfg)))
|
|
(if (and lay (/= lay ""))
|
|
(ssg-make-layer lay (ssg-layer-farbe-fuer-name lay) nil)
|
|
(setq lay (getvar "CLAYER"))
|
|
)
|
|
(setq handle (cdr (assoc 5 ed)))
|
|
(geruest-beschr-entfernen handle)
|
|
(if (not (tblsearch "APPID" *geruest-beschr-app*)) (regapp *geruest-beschr-app*))
|
|
;; 73 ist immer >= 1, damit gilt Gruppe 11 als Ausrichtungspunkt
|
|
(if (entmake (list '(0 . "TEXT")
|
|
(cons 8 lay)
|
|
(cons 7 (geruest-beschr-stil (cdr (assoc "stil" cfg))))
|
|
(cons 10 (nth 0 lage))
|
|
(cons 11 (nth 0 lage))
|
|
(cons 40 (cdr (assoc "hoehe" cfg)))
|
|
(cons 1 (geruest-traeger-text-string
|
|
(cdr (assoc "format" cfg))
|
|
(cdr (assoc "text" cfg)) laenge))
|
|
(cons 50 (nth 1 lage))
|
|
(cons 72 (nth 2 lage))
|
|
(cons 73 (nth 3 lage))
|
|
(list -3 (list *geruest-beschr-app* (cons 1005 handle)))))
|
|
(setq erg (if variante "ok" "ersatz"))
|
|
)
|
|
)
|
|
)
|
|
erg
|
|
)
|
|
|
|
;; Alle Traeger der Zeichnung (neu) beschriften und Beschriftungen, deren
|
|
;; Block nicht mehr existiert, entfernen - unabhaengig von der Checkbox im
|
|
;; Einfuegedialog.
|
|
(defun c:GERUEST_TRAEGER_BESCHRIFTEN ( / ss i n-ok n-ersatz n-fehl n-weg e h ziel erg)
|
|
(setq *geruest-beschr-gemeldet* nil)
|
|
(setq n-ok 0 n-ersatz 0 n-fehl 0 n-weg 0)
|
|
(ssg-start nil nil)
|
|
;; Verwaiste Beschriftungen zuerst entfernen
|
|
(if (setq ss (geruest-beschr-alle))
|
|
(progn
|
|
(setq i 0)
|
|
(repeat (sslength ss)
|
|
(setq e (ssname ss i))
|
|
(setq h (geruest-beschr-handle e))
|
|
(setq ziel (if h (handent h)))
|
|
(if (not (and ziel (entget ziel)
|
|
(= (cdr (assoc 0 (entget ziel))) "INSERT")))
|
|
(progn (entdel e) (setq n-weg (1+ n-weg)))
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "GR_Traeger_*"))))
|
|
(progn
|
|
(setq i 0)
|
|
(repeat (sslength ss)
|
|
(setq erg (geruest-traeger-beschriften (ssname ss i)))
|
|
(cond ((= erg "ok") (setq n-ok (1+ n-ok)))
|
|
((= erg "ersatz") (setq n-ersatz (1+ n-ersatz)))
|
|
(T (setq n-fehl (1+ n-fehl))))
|
|
(setq i (1+ i))
|
|
)
|
|
(princ (ssg-textf "gr-tr-beschr-ergebnis"
|
|
(list (itoa (+ n-ok n-ersatz)) (itoa n-ersatz) (itoa n-fehl) (itoa n-weg))))
|
|
)
|
|
(princ (ssg-text "gr-tr-beschr-keine"))
|
|
)
|
|
(ssg-end)
|
|
(princ)
|
|
)
|
|
|
|
(defun c:GERUEST_TRAEGER ( / bg wahl)
|
|
(setq bg (geruest-baugruppe "Traeger" (geruest-traeger-daten)))
|
|
(cond
|
|
((null bg)
|
|
(princ (ssg-textf "gr-fehler-baugruppe" (list "Traeger"))))
|
|
((null (ssg-json-get bg "geometrie_varianten"))
|
|
(princ (ssg-textf "gr-fehler-keine-varianten" (list "Traeger"))))
|
|
((null (setq wahl (geruest-traeger-dialog bg)))
|
|
(princ (ssg-text "gr-abgebrochen")))
|
|
(T (geruest-traeger-einfuegen bg wahl))
|
|
)
|
|
(princ)
|
|
)
|
|
|
|
(princ "\nGeruestInsert.lsp geladen. Befehle: GERUEST, GERUEST_SAEULEN, GERUEST_ROHRABHAENGER, GERUEST_WANDBEFESTIGUNG, GERUEST_TRAEGER, GERUEST_TRAEGER_BESCHRIFTEN")
|
|
(princ)
|