diff --git a/Lisp/ssg_id.lsp b/Lisp/ssg_id.lsp new file mode 100644 index 0000000..df19ac2 --- /dev/null +++ b/Lisp/ssg_id.lsp @@ -0,0 +1,201 @@ +;; ============================================================ +;; SSG_ID - Eindeutige ID-Verwaltung fuer SSG_LIB Bloecke +;; +;; Jedes eingefuegte Element erhaelt ein Attribut "ID" mit +;; einer eindeutigen, vierstelligen Nummer (z.B. "0001"). +;; +;; Befehle: +;; IDGENERATE - Weist dem zuletzt eingefuegten Block eine neue ID zu +;; IDSCHECK - Prueft alle Bloecke auf doppelte IDs und korrigiert sie +;; +;; Funktionen: +;; (ssg-id-max) - Hoechste ID in der Zeichnung ermitteln +;; (ssg-id-generate ent) - Neue ID erzeugen und auf Block setzen +;; (ssg-id-check-all) - Doubletten pruefen und korrigieren +;; (ssg-id-format n) - Zahl als 4-stelligen String formatieren +;; ============================================================ + + +;; --- ID als 4-stelligen String formatieren --- +;; n = Integer (z.B. 1 -> "0001", 42 -> "0042") +(defun ssg-id-format (n / s) + (setq s (itoa n)) + (while (< (strlen s) 4) + (setq s (strcat "0" s)) + ) + s +) + + +;; --- Alle exportierbaren INSERT-Entities sammeln --- +;; Gleiche Filterlogik wie csv:collect-export-blocks +(defun ssg-id-collect-blocks ( / ss-all ss-out i ename ed bname) + (setq ss-all (ssget "X" (list (cons 0 "INSERT")))) + (if (null ss-all) + nil + (progn + (setq ss-out (ssadd)) + (setq i 0) + (while (setq ename (ssname ss-all i)) + (setq ed (entget ename)) + (setq bname (cdr (assoc 2 ed))) + (if (or + (wcmatch bname "KR_*,KREISEL_*,ECKRAD_*") + (wcmatch (strcase bname) "AP110*,AP_110*,AP60*,AP_60*,APG110*") + (wcmatch bname "Vario*,Staustrecke*,AUS_Element*,EIN_Element*") + (wcmatch bname "#*") + ) + (ssadd ename ss-out) + ) + (setq i (1+ i)) + ) + (if (= (sslength ss-out) 0) nil ss-out) + ) + ) +) + + +;; --- Hoechste ID in der Zeichnung ermitteln --- +;; Durchsucht alle exportierbaren Bloecke nach dem Attribut "ID". +;; Rueckgabe: Integer (hoechste ID) oder 0 wenn keine gefunden. +(defun ssg-id-max ( / ss i ename attribs id-val id-num max-id) + (setq max-id 0) + (setq ss (ssg-id-collect-blocks)) + (if ss + (progn + (setq i 0) + (while (setq ename (ssname ss i)) + (setq attribs (ssg-attrib-read ename)) + (setq id-val (cdr (assoc "ID" attribs))) + (if (and id-val (> (strlen id-val) 0)) + (progn + (setq id-num (atoi id-val)) + (if (> id-num max-id) + (setq max-id id-num) + ) + ) + ) + (setq i (1+ i)) + ) + ) + ) + max-id +) + + +;; --- Neue ID erzeugen und auf einen Block setzen --- +;; ent = Entity-Name eines INSERT-Blocks mit ID-Attribut +;; Rueckgabe: Die zugewiesene ID als String oder nil bei Fehler +(defun ssg-id-generate (ent / max-id new-id new-id-str) + (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT")) + (progn + (setq max-id (ssg-id-max)) + (setq new-id (1+ max-id)) + (setq new-id-str (ssg-id-format new-id)) + (ssg-attrib-set-on ent (list (cons "ID" new-id-str))) + (princ (strcat "\n[ID] Neue ID zugewiesen: " new-id-str)) + new-id-str + ) + (progn + (princ "\n[ID] FEHLER: Kein gueltiger INSERT-Block!") + nil + ) + ) +) + + +;; --- Alle Bloecke auf doppelte IDs pruefen und korrigieren --- +;; Findet Bloecke mit gleicher ID. Behaelt die erste Instanz, +;; weist Duplikaten neue IDs zu. +;; Rueckgabe: Anzahl korrigierter IDs +(defun ssg-id-check-all ( / ss i ename attribs id-val id-num + id-map entry max-id fixed-count new-id-str) + (setq ss (ssg-id-collect-blocks)) + (if (null ss) + (progn + (princ "\n[IDSCHECK] Keine relevanten Bloecke gefunden.") + 0 + ) + (progn + ;; Phase 1: Alle IDs sammeln und hoechste ID ermitteln + (setq id-map nil) + (setq max-id 0) + (setq i 0) + (while (setq ename (ssname ss i)) + (setq attribs (ssg-attrib-read ename)) + (setq id-val (cdr (assoc "ID" attribs))) + (if (and id-val (> (strlen id-val) 0)) + (progn + (setq id-num (atoi id-val)) + (if (> id-num max-id) (setq max-id id-num)) + ;; In Map eintragen: (id-num . (ename1 ename2 ...)) + (setq entry (assoc id-num id-map)) + (if entry + (setq id-map (subst (cons id-num (append (cdr entry) (list ename))) + entry id-map)) + (setq id-map (cons (cons id-num (list ename)) id-map)) + ) + ) + ;; Block ohne ID -> neue ID zuweisen + (progn + (setq max-id (1+ max-id)) + (setq new-id-str (ssg-id-format max-id)) + (ssg-attrib-set-on ename (list (cons "ID" new-id-str))) + (princ (strcat "\n[IDSCHECK] Fehlende ID gesetzt: " new-id-str + " (Block " (cdr (assoc 2 (entget ename))) ")")) + ) + ) + (setq i (1+ i)) + ) + + ;; Phase 2: Duplikate korrigieren + (setq fixed-count 0) + (foreach entry id-map + (if (> (length (cdr entry)) 1) + (progn + ;; Erste Instanz behalten, Duplikate neu nummerieren + (foreach ename (cdr (cdr entry)) + (setq max-id (1+ max-id)) + (setq new-id-str (ssg-id-format max-id)) + (ssg-attrib-set-on ename (list (cons "ID" new-id-str))) + (princ (strcat "\n[IDSCHECK] Duplikat ID " (ssg-id-format (car entry)) + " -> neue ID " new-id-str + " (Block " (cdr (assoc 2 (entget ename))) ")")) + (setq fixed-count (1+ fixed-count)) + ) + ) + ) + ) + + (princ (strcat "\n[IDSCHECK] Fertig. " (itoa fixed-count) " Duplikate korrigiert.")) + fixed-count + ) + ) +) + + +;; --- Befehl: IDSCHECK --- +;; Prueft alle Bloecke auf doppelte IDs und korrigiert sie. +(defun c:IDSCHECK ( / count) + (ssg-start "IDSCHECK" nil) + (setq count (ssg-id-check-all)) + (princ (strcat "\n[IDSCHECK] " (itoa count) " IDs korrigiert.")) + (ssg-end) + (princ) +) + +;; --- Befehl: IDGENERATE --- +;; Fordert den Benutzer auf, einen Block zu waehlen und weist eine neue ID zu. +(defun c:IDGENERATE ( / ent ed) + (ssg-start "IDGENERATE" nil) + (setq ent (car (entsel "\nBlock waehlen: "))) + (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT")) + (ssg-id-generate ent) + (princ "\n[IDGENERATE] Kein gueltiger Block gewaehlt.") + ) + (ssg-end) + (princ) +) + +(princ "\n[SSG_ID] Geladen.") +(princ) diff --git a/menu/SSG_LIB.mnl b/menu/SSG_LIB.mnl new file mode 100644 index 0000000..8da4ade --- /dev/null +++ b/menu/SSG_LIB.mnl @@ -0,0 +1,132 @@ +;; ============================================================ +;; SSG_LIB.mnl - Automatisch geladen beim MENULOAD von SSG_LIB.mnu +;; +;; Definiert den Lazy-Loader (ssg-ensure) und laedt die +;; Kern-Module (ssg_core, ssg_dbg, ssg_dialog, ssg_layer). +;; Feature-Module werden erst bei Menueklick nachgeladen. +;; ============================================================ + +;; Globale Variable: Pfad zu den LISP-Dateien (aus Umgebungsvariable) +(setq *ssg-lisp-pfad* (getenv "DXFM_LISP")) +(if *ssg-lisp-pfad* + (setq *ssg-lisp-pfad* (vl-string-translate "\\" "/" *ssg-lisp-pfad*)) +) + +;; ------------------------------------------------------------ +;; ssg-ensure - Lazy-Loader fuer SSG_LIB Module +;; +;; Prueft ob ein Modul bereits geladen ist (via *ssg--loaded*). +;; Wenn nicht, laedt es aus DXFM_LISP. +;; Laedt automatisch Kern-Abhaengigkeiten (core, dbg, dialog, layer) +;; falls diese noch nicht geladen sind. +;; ------------------------------------------------------------ +(defun ssg-ensure (modul / flag-sym datei) + ;; Flag-Symbol: *ssg-ssg_core-loaded* etc. + (setq flag-sym (read (strcat "*ssg-" modul "-loaded*"))) + + (if (not (eval flag-sym)) + (progn + ;; Pfad pruefen + (if (null *ssg-lisp-pfad*) + (progn + (setq *ssg-lisp-pfad* (getenv "DXFM_LISP")) + (if *ssg-lisp-pfad* + (setq *ssg-lisp-pfad* (vl-string-translate "\\" "/" *ssg-lisp-pfad*)) + ) + ) + ) + + (if (null *ssg-lisp-pfad*) + (progn + (alert "SSG_LIB: DXFM_LISP nicht gesetzt!\nBitte zuerst setenv.bat ausfuehren.") + (princ "\n[SSG_LIB] FEHLER: DXFM_LISP nicht gesetzt!") + ) + (progn + ;; Kern-Module als Abhaengigkeit laden (falls noch nicht geschehen) + (if (not *ssg-core-loaded*) + (progn + (ssg-ensure-load "ssg_core") + (set '*ssg-core-loaded* t) + (ssg-load-config) + ) + ) + (if (not *ssg-dbg-loaded*) + (progn + (ssg-ensure-load "ssg_dbg") + (set '*ssg-dbg-loaded* t) + ;; Debug-Log oeffnen + (if (and (atoms-family 1 '("DBGOPEN")) (getenv "DXFM_LOG")) + (dbgopen "debugfile.dbg" "DXFM_LOG") + ) + ) + ) + (if (not *ssg-dialog-loaded*) + (progn + (ssg-ensure-load "ssg_dialog") + (set '*ssg-dialog-loaded* t) + ) + ) + (if (not *ssg-layer-loaded*) + (progn + (ssg-ensure-load "ssg_layer") + (set '*ssg-layer-loaded* t) + ) + ) + + ;; Jetzt das angeforderte Modul laden (falls nicht schon ein Kern-Modul) + (if (not (eval flag-sym)) + (progn + (ssg-ensure-load modul) + (set flag-sym t) + ) + ) + ) + ) + ) + ) + (princ) +) + +;; Hilfsfunktion: Datei laden mit Fehlerbehandlung +(defun ssg-ensure-load (modul / datei result) + (setq datei (strcat *ssg-lisp-pfad* "/" modul ".lsp")) + (if (findfile datei) + (progn + (setq result (vl-catch-all-apply 'load (list datei))) + (if (vl-catch-all-error-p result) + (princ (strcat "\n[SSG_LIB] FEHLER beim Laden von " modul ": " + (vl-catch-all-error-message result))) + (princ (strcat "\n[SSG_LIB] Geladen: " modul ".lsp")) + ) + ) + (princ (strcat "\n[SSG_LIB] WARNUNG: " datei " nicht gefunden!")) + ) +) + +;; ------------------------------------------------------------ +;; Beim MNL-Laden: Alle Module laden + Menue einhaengen +;; ------------------------------------------------------------ +(if *ssg-lisp-pfad* + (progn + ;; Alle Module in der richtigen Reihenfolge laden + (ssg-ensure "ssg_core") + (ssg-ensure "ssg_dbg") + (ssg-ensure "ssg_dialog") + (ssg-ensure "ssg_layer") + (ssg-ensure "ssg_id") + (ssg-ensure "KreiselInsert") + (ssg-ensure "VarioFoerderer") + (ssg-ensure "Gefaellestrecke") + (ssg-ensure "export") + (ssg-ensure "tests") + (ssg-ensure "OmniModulInsert") + (ssg-ensure "SSG_LIB_Commands") + + ;; Pulldown-Menue in die Menueleiste einhaengen + (menucmd "P13=+SSG_LIB.POP1") + (setvar "DBLCLKEDIT" 0) + (princ "\n[SSG_LIB] Alle Module geladen. Menue aktiv.") + ) + (princ "\n[SSG_LIB] WARNUNG: DXFM_LISP nicht gesetzt - Befehle nicht verfuegbar.") +) +(princ)