Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Michael Stangl
2026-06-16 17:12:21 +02:00
parent f75a5ad0b1
commit 13e4ebb5fc
2 changed files with 333 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/ssg_id.lsp
+201
View File
@@ -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)