Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros

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)

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-<modul>-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)