835 lines
25 KiB
Common Lisp
835 lines
25 KiB
Common Lisp
;; ============================================================
|
|
;; 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)
|
|
;; ------------------------------------------------------------
|
|
|
|
(defun ssg-start (titel zusatz-vars / xlen xpos xvar)
|
|
;; titel - Anzeigename des Makros
|
|
;; zusatz-vars - Liste zusaetzlicher Variablen z.B. '(("OSMODE")("ORTHOMODE"))
|
|
;; Immer CLAYER und CMDECHO werden automatisch gesichert.
|
|
(setq _ssg-olderr *error*
|
|
*error* (function ssg-errhan)
|
|
_ssg-cavar (append '(("CLAYER") ("CMDECHO")) zusatz-vars)
|
|
xlen (length _ssg-cavar)
|
|
xpos 0
|
|
)
|
|
(repeat xlen
|
|
(setq xvar (car (nth xpos _ssg-cavar))
|
|
_ssg-cavar (subst (cons xvar (getvar xvar))
|
|
(nth xpos _ssg-cavar) _ssg-cavar)
|
|
xpos (1+ xpos)
|
|
)
|
|
)
|
|
(setvar "CMDECHO" 0)
|
|
(command "_undo" "_G")
|
|
(graphscr)
|
|
(if titel (prompt (strcat "\n***** " titel " *****\n")))
|
|
(princ)
|
|
)
|
|
|
|
(defun ssg-end (/ xpos xlen xvar)
|
|
(if _ssg-cavar
|
|
(progn
|
|
(command)
|
|
(command "_undo" "_E")
|
|
(setq xpos 1
|
|
xlen (length _ssg-cavar)
|
|
)
|
|
(if (/= (getvar "CLAYER") (caar _ssg-cavar))
|
|
(command "_LAYER" "_SE" (cdar _ssg-cavar) "")
|
|
)
|
|
(repeat (1- xlen)
|
|
(setq xvar (nth xpos _ssg-cavar)
|
|
xpos (1+ xpos)
|
|
)
|
|
(setvar (car xvar) (cdr xvar))
|
|
)
|
|
)
|
|
)
|
|
(if _ssg-olderr (setq *error* _ssg-olderr))
|
|
(princ)
|
|
)
|
|
|
|
(defun ssg-errhan (em)
|
|
(if (= em "Function cancelled")
|
|
(princ)
|
|
(progn (princ "\nFehler: ") (princ em))
|
|
)
|
|
(command)
|
|
(command)
|
|
(ssg-end)
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; 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 " Y/N <Y>: ")) "No")
|
|
)
|
|
(progn
|
|
(initget 1 "Yes No No")
|
|
(= (getkword (strcat "\n" prompt-text " Y/N <N>: ")) "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 setzen
|
|
;; lay-name = Name; color = Farbnummer als String z.B. "2"; set-aktiv = T/nil
|
|
(defun ssg-make-layer (lay-name color set-aktiv)
|
|
(if set-aktiv
|
|
(command "_LAYER" "_M" lay-name "_CO" color lay-name "")
|
|
(command "_LAYER" "_N" lay-name "_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 (strcat "Blockname '" bname "' existiert bereits - wird uebersprungen."))
|
|
(setq bname (strcat "x" bname))
|
|
(command "_block" bname pt ss "")
|
|
(command "_insert" bname pt "" "" rotation)
|
|
)
|
|
)
|
|
bname
|
|
)
|
|
|
|
|
|
;; ------------------------------------------------------------
|
|
;; 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))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; 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 (strcat "\nFEHLER: Block nicht gefunden: " 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 (init-fn))
|
|
(action_tile "accept" "(if accept-fn (accept-fn)) (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)
|
|
|
|
;; 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)
|