Lisp Routine erstellt, die jedem Element beim Export eine Id gibt. Menüs dynamisch gemacht, d.h. die Lisp Routinen werden erst geladen, wenn sie vom Nutzer per MEnü aufgerufen wurden
This commit is contained in:
+201
@@ -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)
|
||||
@@ -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)
|
||||
Reference in New Issue
Block a user