;; ============================================================ ;; SSG_CORE.LSP - Kernbibliothek: Umgebung, Fehler, Dialog ;; Allgemeingueltige Hilfsfunktionen fuer AutoCAD-LISP Makros ;; Ursprung: ACADSST/MENU/ssg.lsp, pu1pu2.lsp (Schoenenberger) ;; Bereinigt und verallgemeinert: 2025 ;; ============================================================ ;; ------------------------------------------------------------ ;; UMGEBUNGSSICHERUNG ;; Sichert Systemvariablen vor Makroausfuehrung und stellt ;; sie danach wieder her. Wird immer als Paar verwendet: ;; (ssg-start "Titel" '(("OSMODE") ("ORTHOMODE"))) ;; ... Makrocode ... ;; (ssg-end) ;; ;; Nestbar ueber *ssg-start-stack*: jedes ssg-start legt einen eigenen ;; Frame (vorheriger *error*-Handler + Variablenwerte) oben auf den ;; Stack, ssg-end nimmt genau diesen Frame wieder herunter. Noetig, weil ;; z.B. ein Test-Wrapper (ssg-start "TEST_KREISEL" ...) selbst wieder ;; Makros aufruft, die ihrerseits ssg-start/ssg-end nutzen - mit einer ;; einzelnen globalen Variable statt eines Stacks wuerde der innere ;; Aufruf den *error*-Handler und die CLAYER/CMDECHO/...-Werte des ;; aeusseren Aufrufs ueberschreiben. Ergebnis waere ein *error* wird ;; nach dem aeusseren ssg-end dauerhaft an ssg-errhan haengen bleiben ;; (statt zum urspruenglichen Default-Handler zurueckzukehren) und bei ;; jedem folgenden Fehler faelschlich veraltete CLAYER/CECOLOR-Werte ;; ueber "_LAYER"/"_undo" auf die Kommandozeile schreiben. ;; ------------------------------------------------------------ (if (not (boundp '*ssg-start-stack*)) (setq *ssg-start-stack* nil)) (defun ssg-start (titel zusatz-vars / cavar xlen xpos xvar) ;; titel - Anzeigename des Makros ;; zusatz-vars - Liste zusaetzlicher Variablen z.B. '(("OSMODE")("ORTHOMODE")) ;; Immer CLAYER und CMDECHO werden automatisch gesichert. (setq cavar (append '(("CLAYER") ("CMDECHO")) zusatz-vars) xlen (length cavar) xpos 0 ) (repeat xlen (setq xvar (car (nth xpos cavar)) cavar (subst (cons xvar (getvar xvar)) (nth xpos cavar) cavar) xpos (1+ xpos) ) ) (setq *ssg-start-stack* (cons (cons *error* cavar) *ssg-start-stack*)) (setq *error* (function ssg-errhan)) (setvar "CMDECHO" 0) (command "_undo" "_G") (graphscr) (if titel (prompt (ssg-textf "core-start-titel" (list titel)))) (princ) ) (defun ssg-end (/ frame cavar xpos xlen xvar) (if *ssg-start-stack* (progn (setq frame (car *ssg-start-stack*) *ssg-start-stack* (cdr *ssg-start-stack*) cavar (cdr frame) ) (command) (command "_undo" "_E") (setq xpos 1 xlen (length cavar) ) (if (/= (getvar "CLAYER") (caar cavar)) (command "_LAYER" "_SE" (cdar cavar) "") ) (repeat (1- xlen) (setq xvar (nth xpos cavar) xpos (1+ xpos) ) (setvar (car xvar) (cdr xvar)) ) (setq *error* (car frame)) ) ) (princ) ) (defun ssg-errhan (em) (if (= em "Function cancelled") (princ) (progn (princ (ssg-text "core-errhan-fehler")) (princ em)) ) (command) (command) (ssg-end) ) ;; ------------------------------------------------------------ ;; BLOCK-WRAP MIT GARANTIERT WELTPARALLELEM BKS ;; ------------------------------------------------------------ ;; Fasst die Entities in ss zu einem Block bname zusammen und fuegt ihn am ;; Welt-Punkt basispkt-welt wieder ein. Setzt das BKS dazu temporaer hart ;; auf Welt und stellt es danach wieder her. ;; ;; Hintergrund (31.95mm-Z-Versatz-Bug): (command "_.-BLOCK"/"_.INSERT" ...) ;; rechnet Punktargumente im AKTUELLEN BKS. Bei einem vom Welt-KS ;; abweichenden BKS ging der korrekt via (trans ...) umgerechnete Z-Wert ;; beim _.-BLOCK -> _.INSERT-Rundlauf verloren, sodass der fertige Block ;; um die BKS-Hoehe (z.B. 31.95mm) in Z verschoben wurde - obwohl die ;; ELEVATION-Systemvariable 0 war. Bei BKS=Welt liegen Objekte, Basispunkt ;; und Einfuegepunkt alle bei WCS-Z ohne jede Umrechnungs-Mehrdeutigkeit; ;; ein bei WCS-Z=0 platziertes Element bleibt garantiert bei Z=0. ;; ;; Rueckgabe: das eingefuegte INSERT-Objekt (entlast). (defun ssg-block-wrap-welt (bname basispkt-welt ss / alt-attreq alt-attdia alt-elev alt-osmode) (setq alt-attreq (getvar "ATTREQ") alt-attdia (getvar "ATTDIA") alt-elev (getvar "ELEVATION") alt-osmode (getvar "OSMODE")) (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) ;; OSMODE=0: laufenden Objektfang abschalten. Sonst kann _.INSERT den ;; explizit uebergebenen Einfuegepunkt (X,Y,0) auf ein an derselben X/Y-Stelle ;; liegendes Objekt umfangen - z.B. den gefangenen Basispunkt bei Z=12000 -> ;; der Block landet auf 12000 statt 0 (12000er-Bug). (setvar "OSMODE" 0) ;; ELEVATION=0: sonst kann _.INSERT die Z-Hoehe aus der aktuellen Elevation ;; statt aus dem uebergebenen Punkt ziehen. (setvar "ELEVATION" 0.0) ;; BKS temporaer auf Welt; _Previous stellt danach das vorige BKS wieder her. (command "_.UCS" "_World") ;; basispkt-welt ist ein Welt-Punkt; bei BKS=Welt ist er zugleich BKS-Punkt. (command "_.-BLOCK" bname basispkt-welt ss "") (command "_.INSERT" bname basispkt-welt 1.0 1.0 0.0) (command "_.UCS" "_Previous") (setvar "OSMODE" alt-osmode) (setvar "ELEVATION" alt-elev) (setvar "ATTREQ" alt-attreq) (setvar "ATTDIA" alt-attdia) (entlast) ) ;; ------------------------------------------------------------ ;; GUI-MODUS (fuer automatische Tests) ;; ------------------------------------------------------------ ;; Globaler Schalter, um alle interaktiven Oberflaechen-Abfragen (DCL-Dialoge, ;; Wizard-Fenster) abzuschalten - dann laufen die Module ueber ihre Konsolen- ;; bzw. Nicht-GUI-Pfade, die von den Testrunnern per Mock-Eingabe/Replay ;; bedient werden. Default nil = GUI an (normaler Betrieb). ;; Test-Setup ruft (ssg-gui-aus) auf; ssg-gui-p fragt den Zustand ab. (if (not (boundp '*ssg-gui-aus*)) (setq *ssg-gui-aus* nil)) (defun ssg-gui-p () (null *ssg-gui-aus*)) ;; T = GUI erlaubt (defun ssg-gui-aus () (setq *ssg-gui-aus* T) (princ)) (defun ssg-gui-an () (setq *ssg-gui-aus* nil) (princ)) ;; ------------------------------------------------------------ ;; LISP-PFAD-ERMITTLUNG ;; ------------------------------------------------------------ ;; Zentraler Ersatz fuer den bisher in mehreren Modulen duplizierten ;; 3-stufigen Pfad-cond (DXFM_LISP env -> *ssg-lisp-pfad* vom MNL -> nil). ;; Liefert das Lisp-Verzeichnis (mit "/"-Trennern, ohne abschliessenden "/") ;; oder nil, wenn keine Quelle gesetzt ist. ;; ;; HINWEIS zur Ladeordnung: Diese Funktion lebt in ssg_core.lsp und ist erst ;; verfuegbar, NACHDEM ssg_core geladen wurde. Der ssg_core-Bootstrap selbst ;; (z.B. in VarioFoerderer.lsp/vf_konstanten.lsp/vf_core.lsp, der ssg_core erst ;; laedt) kann sie daher NICHT nutzen - dort bleibt der Inline-cond stehen. ;; Alle Stellen, die garantiert nach dem ssg_core-Laden laufen, nutzen sie. (defun ssg-lisp-verzeichnis ( / ) (cond ((getenv "DXFM_LISP") (vl-string-translate "\\" "/" (getenv "DXFM_LISP"))) ((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*) *ssg-lisp-pfad*) (t nil) ) ) ;; Vollstaendiger Pfad zu einer Lisp-Datei im Lisp-Verzeichnis (oder nil). ;; dateiname z.B. "vf_core.lsp". (defun ssg-lisp-datei-pfad (dateiname / verz) (setq verz (ssg-lisp-verzeichnis)) (if verz (strcat verz "/" dateiname) nil) ) ;; ------------------------------------------------------------ ;; 3D-ROTATIONSMATRIX ;; ------------------------------------------------------------ ;; 4x4-Rotationsmatrix Rz(hz)*Ry(vert) fuer vla-TransformBy (vlax-tmatrix). ;; Argumente sind die BEREITS berechneten Winkelfunktionen: ;; chz = cos(hz), shz = sin(hz) (horizontale Fahrtrichtung) ;; cv = cos(vert), sv = sin(vert) (vertikale Neigung, positiv = abwaerts) ;; Diese Matrix stand zuvor woertlich in insert-*-Funktionen von vf_core, ;; vf_etage, Gefaellestrecke und TEFInsert. Zentral hier, weil dependency-frei ;; und clusteruebergreifend genutzt. Werte unveraendert - reine Extraktion. (defun ssg-rot-matrix-zy (chz shz cv sv) (list (list (* chz cv) (- shz) (* chz sv) 0) (list (* shz cv) chz (* shz sv) 0) (list (- sv) 0 cv 0) (list 0 0 0 1) ) ) ;; ------------------------------------------------------------ ;; BENUTZER-ABFRAGEN ;; ------------------------------------------------------------ ;; Ja/Nein-Abfrage mit konfigurierbarem Default ;; defa = T -> Default ist "Yes" (Eingabe noetig um "No" zu waehlen) ;; defa = nil -> Default ist "No" ;; Rueckgabe: T wenn "No" gewaehlt (also Ablehnung), nil wenn "Yes" (defun ssg-ques (prompt-text defa) (if defa (progn (initget 1 "Yes No Yes") (= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-yes"))) "No") ) (progn (initget 1 "Yes No No") (= (getkword (strcat "\n" prompt-text (ssg-text "ques-yn-default-no"))) "Yes") ) ) ) ;; Fehlermeldung mit optionalem Signalton ;; ssg-bell = T -> kein Ton; nil -> Ton ausgeben (defun ssg-emsg (text) (if (not ssg-bell) (prompt "\007")) (terpri) (prompt text) (terpri) ) ;; ------------------------------------------------------------ ;; LAYER-HILFSFUNKTIONEN ;; ------------------------------------------------------------ ;; Layer eines angeklickten Objektes ermitteln ;; txt = Prompt-Text fuer Objektauswahl ;; Rueckgabe: Layername als String, nil wenn Abbruch (defun ssg-get-layer (txt / sel) (if (setq sel (entsel txt)) (cdr (assoc 8 (entget (car sel)))) ) ) ;; Alle Objekte eines bestimmten Layers als Auswahlsatz liefern ;; lay-name = Layername; ent-typ = Entitaetstyp z.B. "LINE" (nil = alle) (defun ssg-layer-ss (lay-name ent-typ) (if ent-typ (ssget "X" (list (cons 0 ent-typ) (cons 8 lay-name))) (ssget "X" (list (cons 8 lay-name))) ) ) ;; Layer anlegen (falls nicht vorhanden) und optional aktivieren ;; lay-name = Name; color = Farbnummer als String z.B. "2"; set-aktiv = T/nil ;; Farbe wird nur bei Neuanlage gesetzt, bestehende Layer bleiben unveraendert (defun ssg-make-layer (lay-name color set-aktiv / neu) (setq neu (not (tblsearch "LAYER" lay-name))) (if set-aktiv (command "_LAYER" "_M" lay-name "") (command "_LAYER" "_N" lay-name "") ) (if neu (command "_LAYER" "_CO" color lay-name "") ) ) ;; Auswahlsatz-Iteration: Funktion fuer jedes Element aufrufen ;; ss = Auswahlsatz; func = Funktion mit einem Parameter (entity-name) (defun ssg-ss-foreach (ss func / i ename) (if ss (progn (setq i 0) (while (setq ename (ssname ss i)) (func ename) (setq i (1+ i)) ) ) ) ) ;; Alle Elemente eines Auswahlsatzes hervorheben/zuruecksetzen ;; ss = Auswahlsatz; modus = 3 (hervorheben) / 4 (invertiert) / 0 (normal) (defun ssg-ss-redraw (ss modus / i ename) (if ss (progn (setq i 0) (while (setq ename (ssname ss i)) (redraw ename modus) (setq i (1+ i)) ) ) ) ) ;; Auswahlsatz zu einem anderen Auswahlsatz hinzufuegen (in-place) ;; src-ss = Quell-Auswahlsatz; dest-ss = Ziel-Auswahlsatz (wird modifiziert) (defun ssg-ss-add (src-ss dest-ss / i ename) (if (null dest-ss) (setq dest-ss (ssadd))) (setq i 0) (while (setq ename (ssname src-ss i)) (ssadd ename dest-ss) (redraw ename 3) (setq i (1+ i)) ) dest-ss ) ;; ------------------------------------------------------------ ;; BLOCK-OPERATIONEN ;; ------------------------------------------------------------ ;; Zeitstempel als YYYYMMDDHHMMSS erzeugen (fuer eindeutige Blocknamen) (defun ssg-timestamp ( / cd ds ts) (setq cd (rtos (getvar "CDATE") 2 6)) ;; cd = "20260518.143052" -> Punkt entfernen (setq ds (substr cd 1 8)) (setq ts (substr cd 10 6)) (strcat ds ts) ) ;; Eindeutigen Blocknamen aus Einfuegepunkt + Zeitstempel erzeugen ;; pt = Einfuegepunkt (Liste); Rueckgabe: Blockname als String (defun ssg-make-blockname (pt / k1 k2) (setq k1 (strcat (itoa (abs (fix (car pt)))) (itoa (abs (fix (cadr pt)))) (itoa (abs (fix (caddr pt))))) k2 (substr (rtos (getvar "cdate") 2 9) 10 9) ) (strcat k1 k2) ) ;; Einzel-Block einfuegen mit Layer anlegen ;; lay-name = Ziel-Layer; color = Layerfarbe ;; blk-pfad = vollstaendiger Blockpfad (ohne Erweiterung) ;; pt = Einfuegepunkt; xscale yscale = Skalierung ("" = 1) ;; rotation = Drehwinkel als String oder pause fuer interaktiv (defun ssg-insert-block (lay-name color blk-pfad pt xscale yscale rotation) (ssg-make-layer lay-name color T) (command "_insert" blk-pfad pt xscale yscale rotation) ) ;; Block aus Auswahlsatz erstellen und gleich wieder einfuegen ;; pt = Origin; rotation = Drehwinkel als String ;; ss = Auswahlsatz der Elemente ;; Rueckgabe: Blockname (String) (defun ssg-make-block (pt rotation ss / bname gefunden) (setq bname (ssg-make-blockname pt) gefunden (tblsearch "block" bname) ) (if (not gefunden) (progn (command "_block" bname pt ss "") (command "_insert" bname pt "" "" rotation) ) (progn (alert (ssg-textf "core-blockname-exists" (list bname))) (setq bname (strcat "x" bname)) (command "_block" bname pt ss "") (command "_insert" bname pt "" "" rotation) ) ) bname ) ;; ------------------------------------------------------------ ;; ILS-BLOCKDATEI AUFLOESEN (2D/3D-Umschaltung) ;; ------------------------------------------------------------ ;; Aktuell gueltige Dimension ("2D"/"3D") ermitteln, in dieser Reihenfolge: ;; 1) transienter Override *ssg-ils-dim* (fuer gezielten Neubau in EINER ;; Dimension, z.B. Edit-Umschaltung oder Batch-Umwandlung), ;; 2) globaler Modus DXFM_DIM (Default fuer Neubauten), ;; 3) "3D" als Grund-Default. (defun ssg-ils-dim-aktuell ( / ) (cond ((and (boundp '*ssg-ils-dim*) (= (type *ssg-ils-dim*) 'STR)) *ssg-ils-dim*) ((= (type (getenv "DXFM_DIM")) 'STR) (getenv "DXFM_DIM")) (t "3D"))) ;; Basisverzeichnis der ILS-Bloecke (…/data/ils/) oder nil. (defun ssg-ils-basis ( / ) (cond ((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR)) (strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO"))) "/data/ils/")) ((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR) (vl-string-search "/Lisp" *ssg-lisp-pfad*)) (strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*)) "/data/ils/")) (t nil))) ;; Effektiver Blockname zu einem ROH-Namen fuer eine EXPLIZITE Dimension. ;; Seit dem Flach-Refactor tragen Blocknamen das Dimensionssuffix _2D/_3D, damit ;; 2D- und 3D-Variante gleichzeitig in einer Zeichnung existieren koennen ;; (Datei = Blockname + ".dwg", flach unter data/ils/). Ausnahmen ohne Suffix: ;; - Koordinaten-/Subbloecke KS_EIN/KS_AUS/KSYS_*/K1..K4 (exakte Export-Matches), ;; - bereits mit _2D/_3D versehene Namen (kein doppeltes Anhaengen). (defun ssg-ils-blockname-dim (roh dim / ) (cond ((wcmatch (strcase roh) "KS_EIN,KS_AUS,KSYS_EIN,KSYS_AUS,K1,K2,K3,K4") roh) ((wcmatch (strcase roh) "*_2D,*_3D") roh) (t (strcat roh "_" dim)))) ;; Effektiver Blockname fuer die AKTUELLE Dimension (siehe ssg-ils-dim-aktuell). (defun ssg-ils-blockname (roh / ) (ssg-ils-blockname-dim roh (ssg-ils-dim-aktuell))) ;; Liefert den vollstaendigen .dwg-Pfad (flache Ablage data/ils/.dwg) ;; zu einem ROH-Blocknamen fuer eine EXPLIZITE Dimension. Faellt automatisch auf ;; die 3D-Variante zurueck, wenn die Datei der gewuenschten Dimension (noch) nicht ;; existiert - so nutzen z.B. Vario_Motorstation/-Umlenkstation im 2D-Modus ;; vorlaeufig die 3D-Datei. ;; Rueckgabe: Pfad-String oder nil (Block weder in Dim noch in 3D gefunden). (defun ssg-ils-block-datei-dim (blockname dim / basis datei datei3d) (setq basis (ssg-ils-basis)) (if (null basis) nil (progn (setq datei (strcat basis (ssg-ils-blockname-dim blockname dim) ".dwg")) (setq datei3d (strcat basis (ssg-ils-blockname-dim blockname "3D") ".dwg")) (cond ((findfile datei) datei) ; gewuenschte Dimension ((findfile datei3d) datei3d) ; Fallback: 3D-Variante (t nil)) ) ) ) ;; Wie ssg-ils-block-datei-dim, aber fuer die AKTUELLE Dimension. (defun ssg-ils-block-datei (blockname / ) (ssg-ils-block-datei-dim blockname (ssg-ils-dim-aktuell))) ;; ------------------------------------------------------------ ;; REDEFINE-SPERRE (eine DWG-Lesung pro Block und Zeichnung) ;; ------------------------------------------------------------ ;; Merkliste der in DIESER Zeichnung schon einmal aus der DWG-Datei neu ;; definierten (redefinierten) Blocknamen. Grundlage der Sperre in ;; ssg-ils-block-laden-dim. Namen werden in Grossschreibung gehalten, weil ;; Blocknamen in CAD case-insensitiv sind. LISP-Variablen sind pro Dokument ;; eigenstaendig, die Liste gilt also automatisch je Zeichnung. (if (not (boundp '*ssg-block-refreshed*)) (setq *ssg-block-refreshed* nil)) (defun ssg-block-refreshed-p (eff / ) (and (boundp '*ssg-block-refreshed*) (member (strcase eff) *ssg-block-refreshed*) t)) (defun ssg-block-refreshed-set (eff / ) (if (not (ssg-block-refreshed-p eff)) (setq *ssg-block-refreshed* (cons (strcase eff) *ssg-block-refreshed*))) eff) ;; Sperre aufheben - erzwingt beim naechsten ssg-ils-block-laden(-dim) ein ;; erneutes Einlesen der DWG. Argument nil: ALLE Bloecke; ROH- oder effektiver ;; Blockname: nur dieser (beide Dimensionen). Noetig, wenn eine Block-DWG ;; waehrend der laufenden Sitzung geaendert wurde. (defun ssg-block-refresh-reset (blockname / rest n2 n3 nroh) (if (null blockname) (setq *ssg-block-refreshed* nil) (progn (setq nroh (strcase blockname) n2 (strcase (ssg-ils-blockname-dim blockname "2D")) n3 (strcase (ssg-ils-blockname-dim blockname "3D")) rest '()) (foreach n *ssg-block-refreshed* (if (not (or (= n nroh) (= n n2) (= n n3))) (setq rest (cons n rest)))) (setq *ssg-block-refreshed* rest))) (princ)) ;; Stellt sicher, dass die Block-DEFINITION zum ROH-Namen 'blockname' in einer ;; EXPLIZITEN Dimension geladen ist. Blocknamen tragen das Suffix _2D/_3D ;; (siehe ssg-ils-blockname-dim), daher koennen 2D und 3D gleichzeitig existieren. ;; Ein bereits vorhandener gleichnamiger Block wird EINMAL PRO ZEICHNUNG neu aus ;; der Datei definiert (Redefine), damit eine veraltete Definition aus einer ;; frueheren Sitzung (z.B. mit falschem 2D/3D-Inhalt) nicht wiederverwendet wird. ;; Jeder WEITERE Aufruf fuer denselben effektiven Blocknamen ueberspringt das ;; Neu-Definieren (siehe *ssg-block-refreshed*): Ohne diese Sperre las jede ;; einzelne Element-Einfuegung die DWG erneut von der Platte - bei den grossen ;; 3D-Bloecken (AS_Element_90_links_3D ~52 MB, ES_Element_90_links_3D ~9 MB) ;; und zusaetzlich einer Regeneration aller bereits platzierten Referenzen ;; dieses Blocks. Bei Tests mit vielen Strecken (TEST_MUBEA, Gefaellestrecke- ;; und Foerderer-Tests) fuehrte das zu minutenlangen Laufzeiten. ;; Zum erzwungenen Neu-Einlesen: ssg-block-refresh-reset. ;; Rueckgabe: effektiver (suffigierter) Blockname oder nil (Datei nicht gefunden). (defun ssg-ils-block-laden-dim (blockname dim / eff datei base temp-obj osm areq adia) (setq eff (ssg-ils-blockname-dim blockname dim)) (setq datei (ssg-ils-block-datei-dim blockname dim)) (if (null datei) nil (progn (setq base (vl-filename-base datei)) ;; Sichtbar machen, wenn die Datei der gewuenschten Dimension fehlt und der ;; 3D-Fallback greift (dann traegt der Block den gewuenschten Namen, aber ;; den Inhalt der anderen Dimension = potenziell falsche Referenz). Jeder ;; aktiv eingefuegte Block sollte in BEIDEN Dimensionen vorliegen. (if (not (= (strcase base) (strcase eff))) (princ (strcat "\n[SSG] WARNUNG: Blockdatei '" eff ".dwg' fehlt - Fallback auf '" base ".dwg' (Inhalt evtl. andere Dimension)."))) ;; In dieser Zeichnung bereits aus der Datei aktualisiert UND noch in der ;; Blocktabelle vorhanden -> nichts zu tun, die Definition ist aktuell. ;; Die tblsearch-Pruefung faengt ab, dass der Block zwischenzeitlich ;; entfernt wurde (z.B. per PURGE) und neu geladen werden muss. (if (and (ssg-block-refreshed-p eff) (tblsearch "BLOCK" eff)) eff (progn (if (and (not (tblsearch "BLOCK" eff)) (= (strcase base) (strcase eff))) ;; Neu UND Dateiname == Blockname -> COM-Weg (kein Prompt). (progn (setq temp-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) datei 1.0 1.0 1.0 0)) (vla-Delete temp-obj)) ;; Sonst (Block existiert bereits ODER Dateiname != Blockname wg. ;; 3D-Fallback) -> aus Datei (neu) definieren. "_Y" beantwortet die ;; Redefine-Abfrage, falls der Block bereits vorhanden ist; danach die ;; laufende Einfuegung sofort abbrechen (Definition ist bereits wirksam). (progn (setq areq (getvar "ATTREQ") adia (getvar "ATTDIA") osm (getvar "OSMODE")) (setvar "ATTREQ" 0)(setvar "ATTDIA" 0)(setvar "OSMODE" 0) (if (tblsearch "BLOCK" eff) (command "_.-INSERT" (strcat eff "=" datei) "_Y") ; Redefine bestehender Block (command "_.-INSERT" (strcat eff "=" datei))) ; neu (kein Redefine-Prompt) (if (> (getvar "CMDACTIVE") 0) (command)) (if (> (getvar "CMDACTIVE") 0) (command)) (setvar "OSMODE" osm)(setvar "ATTREQ" areq)(setvar "ATTDIA" adia))) ;; Nur merken, wenn die Definition danach wirklich vorhanden ist - ;; sonst wuerde ein fehlgeschlagener Ladeversuch dauerhaft gesperrt. (if (tblsearch "BLOCK" eff) (ssg-block-refreshed-set eff)) eff))))) ;; Wie ssg-ils-block-laden-dim, aber fuer die AKTUELLE Dimension. (defun ssg-ils-block-laden (blockname / ) (ssg-ils-block-laden-dim blockname (ssg-ils-dim-aktuell))) ;; ------------------------------------------------------------ ;; AUTO-LAYER: INSERT-Referenz auf die eigene Ebene ihres Blocks setzen ;; ------------------------------------------------------------ ;; Ermittelt die "eigene" Ebene eines geladenen Blocks (haeufigste Ebene ausser ;; "0" seiner Definition-Entities); nil, wenn nur "0". (defun ssg-ils-block-ebene (realname / blocks blk e lay pair counts best best-n c) (if (and realname (tblsearch "BLOCK" realname)) (progn (setq blocks (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq blk (vla-item blocks realname)) (setq counts '()) (vlax-for e blk (setq lay (vla-get-Layer e)) (if (and lay (/= lay "0")) (progn (setq pair (assoc lay counts)) (if pair (setq counts (subst (cons lay (1+ (cdr pair))) pair counts)) (setq counts (cons (cons lay 1) counts)))))) (setq best nil best-n 0) (foreach c counts (if (> (cdr c) best-n) (setq best (car c) best-n (cdr c)))) best) nil)) ;; Setzt die INSERT-Referenz (VLA-Objekt) auf die eigene Ebene ihres Blocks ;; (legt die Ebene an, falls noetig). No-op, wenn keine eigene Ebene ermittelbar. (defun ssg-ils-block-auf-ebene (obj realname / eb) (setq eb (ssg-ils-block-ebene realname)) (if (and eb obj) (progn (if (not (tblsearch "LAYER" eb)) (ssg-make-layer eb 7 nil)) (vl-catch-all-apply (function (lambda () (vla-put-Layer obj eb)))))) obj) ;; ------------------------------------------------------------ ;; DIMENSIONS-XDATA (2D/3D) je Block - App "SSG_DIM" ;; ------------------------------------------------------------ ;; Merkt sich, in welcher Dimension ein GF_/VF_-Block gebaut wurde, damit der ;; Doppelklick-Edit die aktuelle Dimension automatisch erkennen kann. Bewusst ;; getrennt vom fachlichen XDATA/Attributsatz (Export bleibt unveraendert). (if (null *ssg-dim-xdata-app*) (setq *ssg-dim-xdata-app* "SSG_DIM")) (defun ssg-dim-xdata-schreiben (ent dim / ) (if (and ent dim) (progn (regapp *ssg-dim-xdata-app*) (entmod (append (entget ent) (list (list -3 (list *ssg-dim-xdata-app* (cons 1000 dim)))))))) ent) ;; Rueckgabe: "2D"/"3D" oder nil (kein Eintrag -> Aufrufer nimmt Default 3D). (defun ssg-dim-xdata-lesen (ent / xd app-data) (setq xd (entget ent (list *ssg-dim-xdata-app*))) (setq app-data (cdr (assoc -3 xd))) (if app-data (car (mapcar 'cdr (cdr (car app-data)))) nil)) ;; ------------------------------------------------------------ ;; ATTRIBUT-OPERATIONEN ;; ------------------------------------------------------------ ;; Attribut eines Blocks (letzte Einfuegung) aendern ;; tag = Attributbezeichner (z.B. "ARTINR") ;; wert = neuer Wert ;; ersetzen = T -> vollstaendiger Ersatz; nil -> Anfuegen (defun ssg-attrib-set (tag wert ersetzen / obj typ attr-tag attr-wert) (setq obj (entlast)) (while (not (equal (cdr (assoc 0 (entget obj))) "SEQEND")) (setq typ (cdr (assoc 0 (entget obj)))) (if (equal typ "ATTRIB") (progn (setq attr-tag (cdr (assoc 2 (entget obj))) attr-wert (cdr (assoc 1 (entget obj))) ) (if (equal attr-tag tag) (if ersetzen (entmod (subst (cons 1 wert) (assoc 1 (entget obj)) (entget obj))) (entmod (subst (cons 1 (strcat attr-wert wert)) (assoc 1 (entget obj)) (entget obj))) ) ) ) ) (setq obj (entnext obj)) ) ) ;; Mehrere Attribute eines Blocks auf einmal setzen ;; attrib-alist = Assoziationsliste '(("TAG1" . "Wert1") ("TAG2" . "Wert2") ...) (defun ssg-attrib-set-many (attrib-alist / obj typ tag wert) (setq obj (entlast)) (while (not (equal (cdr (assoc 0 (entget obj))) "SEQEND")) (setq typ (cdr (assoc 0 (entget obj)))) (if (equal typ "ATTRIB") (progn (setq tag (cdr (assoc 2 (entget obj)))) (setq wert (cdr (assoc tag attrib-alist))) (if (and wert (> (strlen wert) 0)) (entmod (subst (cons 1 wert) (assoc 1 (entget obj)) (entget obj))) ) ) ) (setq obj (entnext obj)) ) ) ;; Alle Attribute eines INSERT-Entity als Assoziationsliste lesen. ;; ent = Entity-Name eines INSERT mit Attributen. ;; Rueckgabe: (("TAG1" . "Wert1") ("TAG2" . "Wert2") ...) oder nil (defun ssg-attrib-read (ent / e ed result) (setq e (entnext ent)) (while e (setq ed (entget e)) (if (equal (cdr (assoc 0 ed)) "SEQEND") (setq e nil) (progn (if (equal (cdr (assoc 0 ed)) "ATTRIB") (setq result (cons (cons (cdr (assoc 2 ed)) (cdr (assoc 1 ed))) result)) ) (setq e (entnext e)) ) ) ) (reverse result) ) ;; Default-Attribute aus einer Definitionsliste erzeugen. ;; attrib-defs = Liste von (TAG DEFAULT) Paaren, z.B. '(("TYP" "A") ("NR" "0")) ;; Rueckgabe: Assoziationsliste (("TYP" . "A") ("NR" . "0") ...) (defun ssg-attrib-defaults (attrib-defs / result) (foreach def attrib-defs (setq result (cons (cons (car def) (cadr def)) result)) ) (reverse result) ) ;; Gegebene Attribute mit Defaults zusammenfuehren. ;; given = alist mit Ueberschreibungen (darf nil sein) ;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...) ;; Rueckgabe: vollstaendige alist mit allen Tags (defun ssg-attrib-merge (given attrib-defs / defaults pair existing) (setq defaults (ssg-attrib-defaults attrib-defs)) (if given (foreach pair given (setq existing (assoc (car pair) defaults)) (if existing (setq defaults (subst pair existing defaults)) (setq defaults (append defaults (list pair))) ) ) ) defaults ) ;; Unsichtbare ATTDEF-Entities bei (0,0) erzeugen. ;; Muss VOR dem _BLOCK-Befehl aufgerufen werden, damit die ATTDEFs ;; Teil der Blockdefinition werden. ;; attrib-defs = Definitionsliste ((TAG DEFAULT) ...) ;; text-height = Texthoehe der ATTDEFs (z.B. 50.0) (defun ssg-attrib-make-defs (attrib-defs text-height / ypos) (setq ypos 0.0) (foreach def attrib-defs (entmake (list '(0 . "ATTDEF") '(8 . "0") (cons 10 (list 0.0 ypos 0.0)) (cons 40 text-height) (cons 1 (cadr def)) (cons 3 (car def)) (cons 2 (car def)) '(70 . 1) )) (setq ypos (- ypos (* text-height (ssg-cfg-or "infrastruktur" "attdef_y_spacing_factor" 2.0)))) ) ) ;; Attribute eines bestimmten INSERT-Entity setzen (nicht entlast). ;; ent = Entity-Name des INSERT-Blocks ;; attrib-alist = (("TAG" . "Wert") ...) (defun ssg-attrib-set-on (ent attrib-alist / obj ed typ tag wert) (setq obj (entnext ent)) (while obj (setq ed (entget obj)) (setq typ (cdr (assoc 0 ed))) (if (equal typ "SEQEND") (setq obj nil) (progn (if (equal typ "ATTRIB") (progn (setq tag (cdr (assoc 2 ed))) (setq wert (cdr (assoc tag attrib-alist))) (if (and wert (= (type wert) 'STR) (> (strlen wert) 0)) (progn (entmod (subst (cons 1 wert) (assoc 1 ed) ed)) (entupd obj) ) ) ) ) (setq obj (entnext obj)) ) ) ) ) ;; ============================================================ ;; GEMEINSAMES ATTRIBUT-SCHEMA FUER STRECKEN-BLOECKE ;; (Gefaellestrecke + VarioFoerderer, feste Reihenfolge) ;; ============================================================ ;; Vorderteil (immer vorhanden). Bezeichnung = Blockname (GF_n/VF_n), ;; ARTINR fest 6220 (alle GF/VF). TYP-Wert wird zur Laufzeit gesetzt. ;; ID zuerst (global, jeder eingefuegte Baustein - Kreisel/GF/VF - erhaelt eine ;; neue ID), danach Bezeichnung (= Blockname). Hoehen/Delta mit Einheit _mm. ;; WINKEL_AS/WINKEL_ES: Elementwinkel (30/60/90, als String) des AS-/ES- ;; Elements, sofern eines gewaehlt wurde - sonst leer (kein AS/ES vorhanden). (setq *strecke-attr-front* '(("ID" "") ("Bezeichnung" "") ("ARTINR" "6220") ("MONTAGEHOEHE_m" "0.000") ("HOEHE_VON_mm" "0") ("HOEHE_BIS_mm" "0") ("DELTA_H_mm" "0") ("DELTA_L_mm" "0") ("TYP" "Streckengruppe") ("SEITE_AS" "rechts") ("WINKEL_AS" "") ("SEITE_ES" "rechts") ("WINKEL_ES" "") ("ANZAHL_GF" "0") ("L_GF_m" "0.000") ("GF_WINKEL" "0.0"))) ;; Mittelteil - nur fuer TYP "Streckengruppe" (mehrsegmentig/mit Bogen bzw. VF). ;; Eine einsegmentige Gefaellestrecke ohne Bogen ("Gefaellestrecke") bekommt ;; diese Attribute NICHT. (setq *strecke-attr-gruppe* '(("GF_Bogen_L_90" "0") ("GF_Bogen_L_60" "0") ("GF_Bogen_L_30" "0") ("GF_Bogen_R_90" "0") ("GF_Bogen_R_60" "0") ("GF_Bogen_R_30" "0") ("ANZAHL_VF" "0") ("MOTORSEITE" "") ("L_VF_m" "0.000") ("ANTRIEBFAHRTRICHTUNG" "Auf") ("VF_WINKEL" "0") ("VF_Bogen_A_90" "0") ("VF_Bogen_A_60" "0") ("VF_Bogen_A_30" "0") ("VF_Bogen_I_90" "0") ("VF_Bogen_I_60" "0") ("VF_Bogen_I_30" "0"))) ;; Hinterteil (immer vorhanden). ANZAHL_SEPARATOR-Wert wird zur Laufzeit gesetzt ;; (einsegmentige Gefaellestrecke: 1; Streckengruppe: gezaehlt). (setq *strecke-attr-hinten* '(("ANZAHL_SEPARATOR" "1") ("ANZAHL_SCANNER" "0") ("GERUEST_EINZELMODUL" "1") ("GERUEST_TYP" "Schoenenberger Geruest"))) ;; ============================================================ ;; GERUESTOPTION - gemeinsame Combobox-Werte fuer Kreisel, Eckrad, ;; VarioFoerderer und Gefaellestrecke (Attribut GERUEST_TYP). ;; Reihenfolge = Reihenfolge in der Dialog-Combobox. Index 2 ;; ("Schoenenberger Geruest") ist der Default. ;; ============================================================ (setq *ssg-geruest-optionen* '("IPE-Geruest abgestuft" "Obergeruest oben" "Schoenenberger Geruest" "nur Doppelrohrtraeger") ) ;; Geruest-Typ (String) -> Combobox-Index. Unbekannter/leerer Wert -> Default (2). (defun ssg-geruest-typ-to-idx (typ / idx i gefunden) (setq idx 2 i 0 gefunden nil) (foreach opt *ssg-geruest-optionen* (if (and (not gefunden) (equal typ opt)) (progn (setq idx i) (setq gefunden T)) ) (setq i (1+ i)) ) idx ) ;; Combobox-Index -> Geruest-Typ (String). (defun ssg-geruest-idx-to-typ (idx) (nth idx *ssg-geruest-optionen*) ) ;; Geruestoption per Kommandozeilen-Menue abfragen (fuer Module ohne DCL-Dialog, ;; z.B. ILS_Eckrad). Rueckgabe: Geruest-Typ-String aus *ssg-geruest-optionen*. (defun ssg-ask-geruest-typ ( / i opt antwort idx) (princ (ssg-text "geruest-typ-header")) (setq i 1) (foreach opt *ssg-geruest-optionen* (princ (ssg-textf "geruest-typ-opt" (list i opt))) (setq i (1+ i)) ) (setq antwort (getint (ssg-textf "geruest-typ-prompt" (list (itoa (1+ (ssg-geruest-typ-to-idx nil))))))) (if (or (null antwort) (< antwort 1) (> antwort (length *ssg-geruest-optionen*))) (setq idx (ssg-geruest-typ-to-idx nil)) (setq idx (1- antwort)) ) (ssg-geruest-idx-to-typ idx) ) ;; Geordnete ATTDEF-Definitionsliste fuer einen Strecken-Block-Typ. ;; typ "Gefaellestrecke" -> Vorderteil + Hinterteil (reduziert) ;; sonst ("Streckengruppe") -> Vorderteil + Mittelteil + Hinterteil (voll) (defun ssg-strecke-attrib-defs (typ) (if (= typ "Gefaellestrecke") (append *strecke-attr-front* *strecke-attr-hinten*) (append *strecke-attr-front* *strecke-attr-gruppe* *strecke-attr-hinten*))) ;; Assoziationsliste in ATTDEF-Definitionsliste konvertieren. ;; alist = (("TAG" . "Wert") ...) -> ((TAG Wert) ...) ;; Passend fuer ssg-attrib-make-defs. (defun ssg-attrib-alist-to-defs (alist / result) (foreach pair alist (setq result (cons (list (car pair) (cdr pair)) result)) ) (reverse result) ) ;; Block (.dwg) temporaer einfuegen, Attribute lesen, Block loeschen. ;; dwg-pfad = vollstaendiger Pfad zur .dwg Datei ;; Rueckgabe: Assoziationsliste (("TAG" . "Wert") ...) oder nil (defun ssg-attrib-read-dwg (dwg-pfad / tmpEnt srcAttribs oldAttreq oldAttdia) (if (not (findfile dwg-pfad)) (progn (princ (ssg-textf "core-dwg-not-found" (list dwg-pfad))) nil ) (progn (setq oldAttreq (getvar "ATTREQ")) (setq oldAttdia (getvar "ATTDIA")) (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) (command "_.INSERT" dwg-pfad (list 0.0 0.0 0.0) 1 1 0) (setvar "ATTREQ" oldAttreq) (setvar "ATTDIA" oldAttdia) (setq tmpEnt (entlast)) (setq srcAttribs (ssg-attrib-read tmpEnt)) (command "_.ERASE" tmpEnt "") srcAttribs ) ) ) ;; Attribut eines Blocks anhand seines Handle suchen und aendern ;; handle = Entity-Handle (String) des INSERT ;; tag = Attributbezeichner ;; wert = neuer Wert ;; ersetzen = T -> ersetzen; nil -> anhaengen (defun ssg-attrib-by-handle (handle tag wert ersetzen / e typ blk-tag blk-wert fertig) (setq e (entnext) fertig nil ) (while (and e (not fertig)) (setq typ (cdr (assoc 0 (entget e)))) (if (and (equal (cdr (assoc 5 (entget e))) handle) (equal typ "INSERT") (equal (cdr (assoc 66 (entget e))) 1) ) (progn (while (not (= (cdr (assoc 0 (entget e))) "SEQEND")) (if (equal (cdr (assoc 0 (entget e))) "ATTRIB") (progn (setq blk-tag (cdr (assoc 2 (entget e))) blk-wert (cdr (assoc 1 (entget e))) ) (if (equal blk-tag tag) (if ersetzen (entmod (subst (cons 1 wert) (assoc 1 (entget e)) (entget e))) (entmod (subst (cons 1 (strcat blk-wert wert)) (assoc 1 (entget e)) (entget e))) ) ) ) ) (setq e (entnext e)) ) (setq fertig T) ) ) (setq e (entnext e)) ) ) ;; ------------------------------------------------------------ ;; DIALOG-STANDARD-PATTERN ;; Vorlage fuer DCL-Dialoge: laden, initialisieren, starten ;; Verwendung: ;; (ssg-dialog-run "pfad/dialog.dcl" "dialog-name" init-fn accept-fn) ;; ;; init-fn = Funktion ohne Parameter, setzt Tiles und Actions ;; accept-fn = Funktion ohne Parameter, liest Tiles aus ;; ------------------------------------------------------------ (defun ssg-dialog-run (dcl-pfad dialog-name init-fn accept-fn / dat) (setq dat (load_dialog dcl-pfad)) (if (not (new_dialog dialog-name dat)) (progn (alert "Dialog konnte nicht geladen werden.") (exit)) ) (if init-fn (apply init-fn nil)) (action_tile "accept" "(if accept-fn (apply accept-fn nil)) (done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (start_dialog) (unload_dialog dat) ) ;; ------------------------------------------------------------ ;; ZOOM-HILFSFUNKTIONEN ;; ------------------------------------------------------------ ;; Aktuelle View-Groesse merken (defun ssg-zoom-save () (setq _ssg-view-size (getvar "VIEWSIZE")) ) ;; Auf gespeicherte View-Groesse zurueckschalten (wenn veraendert) (defun ssg-zoom-restore () (if (and _ssg-view-size (/= (getvar "VIEWSIZE") _ssg-view-size)) (command "_ZOOM" "_P") ) ) ;; ------------------------------------------------------------ ;; KONFIGURATION AUS JSON LADEN ;; Liest data/json/component_defaults.json und stellt Werte ;; ueber (ssg-cfg "section" "key") bereit. ;; Struktur: {"section": {"key": wert, ...}, ...} ;; Ergebnis: *ssg-config* = (("section" ("key" . wert) ...) ...) ;; ------------------------------------------------------------ (setq *ssg-config* nil) ;; Datei zeilenweise einlesen (wie omni:read-file-lines) (defun ssg-read-file-lines (datei / f zeile ergebnis) (setq f (open datei "r")) (if (null f) nil (progn (setq ergebnis nil) (while (setq zeile (read-line f)) (setq ergebnis (cons zeile ergebnis)) ) (close f) (reverse ergebnis) ) ) ) ;; Whitespace und Komma trimmen (defun ssg-cfg-trim (s / len) (setq s (vl-string-trim " \t\r\n" s)) (setq len (strlen s)) (if (and (> len 0) (= (substr s len 1) ",")) (setq s (substr s 1 (1- len))) ) (vl-string-trim " \t\r\n" s) ) ;; JSON-Wert parsen (String, Zahl, null, true, false, Array) (defun ssg-cfg-parse-value (val-str / len) (setq val-str (ssg-cfg-trim val-str)) (cond ((= val-str "null") nil) ((= val-str "true") T) ((= val-str "false") nil) ;; String ((= (substr val-str 1 1) "\"") (setq len (strlen val-str)) (if (and (> len 1) (= (substr val-str len 1) "\"")) (substr val-str 2 (- len 2)) val-str ) ) ;; Array [...] -> Liste von Werten parsen ((= (substr val-str 1 1) "[") (ssg-cfg-parse-array val-str) ) ;; Zahl (T (if (vl-string-search "." val-str) (atof val-str) (atoi val-str) ) ) ) ) ;; Einfaches JSON-Array parsen: [1, 2, 3.5, "text"] (defun ssg-cfg-parse-array (arr-str / inhalt teile ergebnis item) (setq inhalt (ssg-cfg-trim arr-str)) ;; Klammern entfernen (setq inhalt (substr inhalt 2 (- (strlen inhalt) 2))) ;; An Kommas aufteilen (einfach: kein verschachteltes Array) (setq teile (ssg-cfg-split-comma inhalt)) (setq ergebnis nil) (foreach item teile (setq ergebnis (cons (ssg-cfg-parse-value item) ergebnis)) ) (reverse ergebnis) ) ;; String an Kommas aufteilen -> Liste von Strings (defun ssg-cfg-split-comma (s / result current i ch) (setq result nil current "" i 1) (repeat (strlen s) (setq ch (substr s i 1)) (if (= ch ",") (progn (setq result (cons current result)) (setq current "") ) (setq current (strcat current ch)) ) (setq i (1+ i)) ) (if (> (strlen (vl-string-trim " " current)) 0) (setq result (cons current result)) ) (reverse result) ) ;; Key-Value-Zeile parsen: "key": wert -> ("key" . wert) (defun ssg-cfg-parse-kv (zeile / pos key rest pos2 val) (setq zeile (ssg-cfg-trim zeile)) (if (and (> (strlen zeile) 0) (= (substr zeile 1 1) "\"")) (progn (setq pos (vl-string-search "\"" zeile 1)) (if pos (progn (setq key (substr zeile 2 (1- pos))) (setq rest (substr zeile (+ pos 2))) (setq pos2 (vl-string-search ":" rest)) (if pos2 (cons key (ssg-cfg-parse-value (substr rest (+ pos2 2)))) ) ) ) ) ) ) ;; --- JSON-Array von flachen Objekten parsen --- ;; Verwendet ssg-cfg-trim und ssg-cfg-parse-kv aus ssg_core. ;; Rueckgabe: Liste von Alists (("key" . wert) ...) (defun ssg-parse-json-array (zeilen / in-obj obj ergebnis zeile kv trimmed) (setq in-obj nil obj nil ergebnis nil) (foreach zeile zeilen (setq trimmed (ssg-cfg-trim zeile)) (cond ((= trimmed "{") (setq in-obj T obj nil)) ((or (= trimmed "}") (= trimmed "},")) (if (and in-obj obj) (setq ergebnis (cons (reverse obj) ergebnis))) (setq in-obj nil)) (in-obj (setq kv (ssg-cfg-parse-kv trimmed)) (if kv (setq obj (cons kv obj)))) ) ) (reverse ergebnis) ) ;; JSON-Datei als flaches Array laden ;; Rueckgabe: Liste von Alists oder nil bei Fehler (defun ssg-load-json (datei / zeilen) (setq zeilen (ssg-read-file-lines datei)) (if zeilen (ssg-parse-json-array zeilen)) ) ;; Wert aus Alist lesen: (ssg-val alist "key") (defun ssg-val (alist key) (cdr (assoc key alist)) ) ;; Verschachteltes JSON-Objekt parsen (1 Ebene tief) ;; {"section": {"key": val, ...}, ...} ;; -> (("section" ("key" . val) ...) ...) (defun ssg-cfg-parse-nested (zeilen / ergebnis section section-data trimmed kv in-section in-inner) (setq ergebnis nil section nil section-data nil in-section nil in-inner nil ) (foreach zeile zeilen (setq trimmed (ssg-cfg-trim zeile)) (cond ;; Aeusseres { oder } ignorieren (Wurzel-Objekt) ((and (not in-section) (= trimmed "{")) nil) ((and (not in-section) (= trimmed "}")) nil) ;; Leere Section auf einer Zeile: "name": {} ;; (Section-Start und -Ende zugleich - json.dump schreibt leere ;; Objekte immer inline, unabhaengig von der Einrueckung.) ((and (not in-inner) (>= (strlen trimmed) 2) (= (substr trimmed (1- (strlen trimmed)) 2) "{}")) (setq section (substr trimmed 2 (1- (vl-string-search "\"" trimmed 1)))) (setq ergebnis (cons (cons section nil) ergebnis)) ) ;; Section-Start: "name": { ((and (not in-inner) (vl-string-search ": {" trimmed)) (setq kv (ssg-cfg-parse-kv (substr trimmed 1 (vl-string-search ": {" trimmed)))) ;; kv ist hier nur der Key-Teil, der Rest ist ": {" ;; Einfacher: Key direkt extrahieren (setq section (substr trimmed 2 (1- (vl-string-search "\"" trimmed 1)))) (setq section-data nil) (setq in-section T in-inner T) ) ;; Section-Ende: } ((and in-inner (or (= trimmed "}") (= trimmed "},"))) (if section (setq ergebnis (cons (cons section (reverse section-data)) ergebnis)) ) (setq in-section nil in-inner nil section nil section-data nil) ) ;; Key-Value innerhalb einer Section (in-inner (setq kv (ssg-cfg-parse-kv trimmed)) (if kv (setq section-data (cons kv section-data))) ) ) ) (reverse ergebnis) ) ;; Konfiguration laden ;; Sucht data/json/component_defaults.json ueber DXFM_DATA (defun ssg-load-config ( / data-pfad cfg-datei zeilen) (setq data-pfad (getenv "DXFM_DATA")) (if (null data-pfad) (princ "\n[CFG] WARNUNG: DXFM_DATA nicht gesetzt, Config nicht geladen.") (progn (setq cfg-datei (strcat data-pfad "/json/component_defaults.json")) (if (not (findfile cfg-datei)) (princ (strcat "\n[CFG] WARNUNG: " cfg-datei " nicht gefunden.")) (progn (setq zeilen (ssg-read-file-lines cfg-datei)) (if zeilen (progn (setq *ssg-config* (ssg-cfg-parse-nested zeilen)) (princ (strcat "\n[CFG] Config geladen: " (itoa (length *ssg-config*)) " Sektionen.")) ) (princ (strcat "\n[CFG] WARNUNG: Leere Config-Datei: " cfg-datei)) ) ) ) ) ) (princ) ) ;; Wert aus Config lesen: (ssg-cfg "section" "key") ;; Gibt den Wert oder nil zurueck. (defun ssg-cfg (section key / sec-data) (if *ssg-config* (progn (setq sec-data (cdr (assoc section *ssg-config*))) (if sec-data (cdr (assoc key sec-data)) ) ) ) ) ;; Wert mit Fallback: (ssg-cfg-or "section" "key" default) (defun ssg-cfg-or (section key default / val) (setq val (ssg-cfg section key)) (if val val default) ) ;; ============================================================ ;; INI-STYLE CONFIG-PARSER (Standard fuer alle cfg/*.cfg-Dateien) ;; ;; Format: ;; [Abschnitt] ;; Key = Wert (einzelner Wert) ;; Key = Wert1, Wert2, Wert3 (kommagetrennte Liste, z.B. fuer wcmatch) ;; # Kommentar / Leerzeile werden ignoriert ;; ;; Verwendung: ;; (setq cfg (ssg-load-ini pfad)) ;; (ssg-ini-get cfg "sektion" "key" "default") ;; (ssg-ini-list cfg "sektion" "key" "a,b,c") ; normalisiert zu "a,b,c" (wcmatch-tauglich) ;; ============================================================ ;; Zeilen einer .cfg-Datei in verschachtelte Alist parsen. ;; Rueckgabe: (("sektion" ("key" . "wert") ...) ...) (defun ssg-ini-parse-lines (zeilen / ergebnis section sec-data trimmed pos key val) (setq ergebnis nil section nil sec-data nil) (foreach zeile zeilen (setq trimmed (vl-string-trim " \t\r\n" zeile)) (cond ;; Leerzeile oder Kommentar ((or (= trimmed "") (= (substr trimmed 1 1) "#")) nil) ;; Abschnitt: [name] ((and (= (substr trimmed 1 1) "[") (= (substr trimmed (strlen trimmed) 1) "]")) (if section (setq ergebnis (cons (cons section (reverse sec-data)) ergebnis))) (setq section (substr trimmed 2 (- (strlen trimmed) 2))) (setq sec-data nil) ) ;; Key=Wert ((and section (setq pos (vl-string-search "=" trimmed))) (setq key (vl-string-trim " \t" (substr trimmed 1 pos))) (setq val (vl-string-trim " \t" (substr trimmed (+ pos 2)))) (setq sec-data (cons (cons key val) sec-data)) ) ) ) (if section (setq ergebnis (cons (cons section (reverse sec-data)) ergebnis))) (reverse ergebnis) ) ;; .cfg-Datei laden und als verschachtelte Alist zurueckgeben, oder nil. (defun ssg-load-ini (cfg-datei / zeilen) (setq zeilen (ssg-read-file-lines cfg-datei)) (if zeilen (ssg-ini-parse-lines zeilen)) ) ;; Einzelwert aus geladener INI-Alist lesen, mit Fallback. ;; ini-data = Rueckgabe von ssg-load-ini (defun ssg-ini-get (ini-data section key default / sec-data val) (setq sec-data (cdr (assoc section ini-data))) (setq val (if sec-data (cdr (assoc key sec-data)))) (if (and val (> (strlen val) 0)) val default) ) ;; Kommagetrennten Wert aus geladener INI-Alist lesen und normalisieren ;; (Leerzeichen um Kommas entfernen, leere Teile verwerfen). ;; default-str = Fallback als kommagetrennter String, falls Config/Key fehlt. ;; Rueckgabe: kommagetrennter String, z.B. "KR_*,KREISEL_*" (wcmatch-tauglich) (defun ssg-ini-list (ini-data section key default-str / raw teile ergebnis item first) (setq raw (ssg-ini-get ini-data section key default-str)) (setq teile (ssg-cfg-split-comma raw)) (setq ergebnis "" first T) (foreach item teile (setq item (vl-string-trim " \t" item)) (if (> (strlen item) 0) (progn (setq ergebnis (if first item (strcat ergebnis "," item))) (setq first nil) ) ) ) ergebnis ) (prompt "\nssg_core.lsp geladen.") (princ)