diff --git a/Lisp/SSG_LIB_Commands.lsp b/Lisp/SSG_LIB_Commands.lsp index 5bcce07..5565920 100644 --- a/Lisp/SSG_LIB_Commands.lsp +++ b/Lisp/SSG_LIB_Commands.lsp @@ -46,6 +46,15 @@ ) (setq pt res) (command "_.INSERT" pfad pt "" "" pause) + ;; Sofort beim Einfuegen eine eindeutige ID vergeben - wie bei allen + ;; anderen Bau-Routinen (Kreisel/GF/VF/Omniflo, siehe ssg-id-generate- + ;; Aufrufe dort). Separator/Scanner waren bisher die einzige Ausnahme + ;; und bekamen ihre ID erst nachtraeglich, gesammelt fuer alle Bloecke + ;; auf einmal, durch ssg-id-check-all vor dem naechsten Export - + ;; das ist der Fall, den ssg-id-check-all als Sicherheitsnetz + ;; eigentlich nur fuer Kopier-/Array-/Spiegel-Faelle abfangen soll. + (if (atoms-family 1 '("ssg-id-generate")) + (ssg-id-generate (entlast))) (setq n (1+ n)) ) (setvar "ATTREQ" oldattreq) diff --git a/Lisp/ssg_id.lsp b/Lisp/ssg_id.lsp index 0bb29ea..c4f4d21 100644 --- a/Lisp/ssg_id.lsp +++ b/Lisp/ssg_id.lsp @@ -35,8 +35,9 @@ ;; bleibt ihr ID-Attribut trotz ATTDEF für immer leer - ssg-attrib-set-on ;; kann nur einen Wert SETZEN, wenn der Block ueberhaupt erst hier landet). (defun ssg-id-collect-blocks ( / ss-all ss-out i ename ed bname) + (dbgf "ssg-id-collect-blocks") (setq ss-all (ssget "X" (list (cons 0 "INSERT")))) - (if (null ss-all) + (dbgreturn (if (null ss-all) nil (progn (setq ss-out (ssadd)) @@ -57,7 +58,7 @@ ) (if (= (sslength ss-out) 0) nil ss-out) ) - ) + )) ) @@ -65,6 +66,7 @@ ;; 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) + (dbgf "ssg-id-max") (setq max-id 0) (setq ss (ssg-id-collect-blocks)) (if ss @@ -85,7 +87,7 @@ ) ) ) - max-id + (dbgreturn max-id) ) @@ -93,7 +95,9 @@ ;; 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")) + (dbgf "ssg-id-generate") + (dbg 'ent) + (dbgreturn (if (and ent (= (cdr (assoc 0 (entget ent))) "INSERT")) (progn (setq max-id (ssg-id-max)) (setq new-id (1+ max-id)) @@ -106,30 +110,64 @@ (princ (ssg-text "id-invalid-block")) nil ) - ) + )) ) +;; --- ID-Attribut setzen UND sofort verifizieren --- +;; ssg-attrib-set-on kann eine Tag/Wert-Zuweisung STILL VERWERFEN, wenn der +;; INSTANZ-spezifische ATTRIB-Eintrag fuer diesen Tag gar nicht existiert +;; (z.B. bei einer Blockreferenz, die vor dem Hinzufuegen des ID-ATTDEF +;; eingefuegt wurde und seither nicht per ATTSYNC aktualisiert wurde) - +;; ohne Fehlermeldung. Das fuehrt genau zu der Art von "unsichtbarem" +;; doppelten ID-Fehler, der ssg-id-check-all eigentlich verhindern soll: +;; die Funktion GLAUBT, sie habe eine neue ID vergeben, aber am Block +;; steht weiterhin die alte (bzw. gar keine) ID. Diese Hilfsfunktion liest +;; nach dem Setzen sofort zurueck und warnt laut, wenn es nicht geklappt hat. +(defun ssg-id-set-and-verify (ename new-id-str kontext-text / attribs-danach) + (dbgf "ssg-id-set-and-verify") + (dbg 'ename) + (dbg 'new-id-str) + (dbg 'kontext-text) + (ssg-attrib-set-on ename (list (cons "ID" new-id-str))) + (setq attribs-danach (ssg-attrib-read ename)) + (dbgreturn (if (not (equal (cdr (assoc "ID" attribs-danach)) new-id-str)) + (princ (strcat "\n[SSG_ID] WARNUNG: ID=" new-id-str " konnte NICHT auf " + (cdr (assoc 2 (entget ename))) " (Handle " + (cdr (assoc 5 (entget ename))) ", " kontext-text + ") geschrieben werden - Block hat vermutlich kein " + "ID-ATTDEF (Attribut-Sync/Redefine noetig).")) + )) +) + ;; --- 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) + id-map entry max-id fixed-count new-id-str bname) + (dbgf "ssg-id-check-all") (setq ss (ssg-id-collect-blocks)) - (if (null ss) + (dbg 'ss) + (dbgp (strcat "Anzahl erfasster Bloecke: " (if ss (itoa (sslength ss)) "0"))) + (dbgreturn (if (null ss) (progn (princ (ssg-text "id-check-no-blocks")) 0 ) (progn ;; Phase 1: Alle IDs sammeln und hoechste ID ermitteln + (dbgp "=== Phase 1: IDs sammeln ===") (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))) + (setq bname (cdr (assoc 2 (entget ename)))) + (dbgp (strcat " [" (itoa i) "] " bname " (Handle " (cdr (assoc 5 (entget ename))) + ") ID-Attrib-vorhanden=" (if (assoc "ID" attribs) "JA" "NEIN") + " id-val=" (if id-val (strcat "\"" id-val "\"") "nil"))) (if (and id-val (> (strlen id-val) 0)) (progn (setq id-num (atoi id-val)) @@ -137,8 +175,12 @@ ;; 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)) + (progn + (dbgp (strcat " ID " id-val " bereits gesehen bei " + (itoa (length (cdr entry))) " anderen Block(en) -> DUPLIKAT-KANDIDAT")) + (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)) ) ) @@ -146,24 +188,46 @@ (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))) + (dbgp (strcat " -> keine/leere ID, weise neu zu: " new-id-str)) + (ssg-id-set-and-verify ename new-id-str "Block ohne ID") (princ (ssg-textf "id-check-missing-set" (list new-id-str (cdr (assoc 2 (entget ename)))))) ) ) (setq i (1+ i)) ) + (dbgp (strcat "Phase 1 abgeschlossen: max-id=" (itoa max-id) + " id-map hat " (itoa (length id-map)) " unterschiedliche ID-Werte")) + (foreach entry id-map + (if (> (length (cdr entry)) 1) + (dbgp (strcat " DUPLIKAT ID=" (ssg-id-format (car entry)) ": " + (itoa (length (cdr entry))) " Bloecke -> " + (apply 'strcat (mapcar + '(lambda (e) (strcat (cdr (assoc 2 (entget e))) "(Handle " + (cdr (assoc 5 (entget e))) ") ")) + (cdr entry))))) + ) + ) ;; Phase 2: Duplikate korrigieren + (dbgp "=== Phase 2: Duplikate korrigieren ===") (setq fixed-count 0) (foreach entry id-map (if (> (length (cdr entry)) 1) (progn ;; Erste Instanz behalten, Duplikate neu nummerieren + (dbgp (strcat "ID=" (ssg-id-format (car entry)) ": behalte " + (cdr (assoc 2 (entget (car (cdr entry))))) " (Handle " + (cdr (assoc 5 (entget (car (cdr entry))))) "), nummeriere " + (itoa (1- (length (cdr entry)))) " weitere um")) (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))) + (dbgp (strcat " " (cdr (assoc 2 (entget ename))) " (Handle " + (cdr (assoc 5 (entget ename))) ") ID=" (ssg-id-format (car entry)) + " -> " new-id-str)) + (ssg-id-set-and-verify ename new-id-str + (strcat "Duplikat von ID=" (ssg-id-format (car entry)))) (princ (ssg-textf "id-check-duplicate" (list (ssg-id-format (car entry)) new-id-str (cdr (assoc 2 (entget ename)))))) @@ -172,11 +236,12 @@ ) ) ) + (dbgp (strcat "Phase 2 abgeschlossen: " (itoa fixed-count) " Duplikate korrigiert")) (princ (ssg-textf "id-check-done" (list fixed-count))) fixed-count ) - ) + )) ) diff --git a/tests/test_mubea.lsp b/tests/test_mubea.lsp index 3e71d42..b953429 100644 --- a/tests/test_mubea.lsp +++ b/tests/test_mubea.lsp @@ -363,6 +363,14 @@ (command) (princ (strcat "\n WARNUNG: INSERT von '" eff "' nicht sauber beendet - abgebrochen.")))) + ;; Sofort beim Einfuegen eine eindeutige ID vergeben - wie bei allen + ;; anderen Bau-Routinen (Kreisel/GF/VF, siehe deren ssg-id-generate- + ;; Aufrufe). Separator/Scanner waren bisher die einzige Ausnahme und + ;; bekamen ihre ID erst nachtraeglich durch ssg-id-check-all vor dem + ;; Export - das ist der Fall, den ssg-id-check-all als Sicherheitsnetz + ;; eigentlich nur fuer Kopier-/Array-/Spiegel-Faelle abfangen soll. + (if (atoms-family 1 '("ssg-id-generate")) + (ssg-id-generate (entlast))) (mubea:ent-json tid "separator" (entlast))) (progn ;; Kein Block gefunden -> sichtbaren Platzhalter zeichnen @@ -444,6 +452,7 @@ ;; ============================================================ (defun c:TEST_MUBEA ( / json-datei daten eintrag tid blk res r results-list sep-idx anz-ok anz-fehler kind) + (dbgopen "mubea_id.dbg" "DXFM_LOG") ;; Benoetigte Feature-Module laden (ssg-ensure "KreiselInsert") @@ -470,12 +479,14 @@ (progn (princ (strcat "\n[TEST_MUBEA] FEHLER: " json-datei " nicht gefunden!")) (ssg-end) + (dbgclose) (exit))) (setq daten (ssg-load-json json-datei)) (if (null daten) (progn (princ "\n[TEST_MUBEA] FEHLER: Testdaten konnten nicht geladen werden.") (ssg-end) + (dbgclose) (exit))) (princ "\n\n================================================================") @@ -526,4 +537,5 @@ (ssg-end) (princ "\n TEST_MUBEA abgeschlossen.") (princ) + (dbgclose) )