[CHANGE] Attribute für ILS Blöcke korrigiert - Artikelnummern für 30 Grad ES AS Elemente hinzugefügt, ZUORDNUNG als Attribut nur bei Scanner und Separator, ID als Attribut für alle Blöcke hinzugefügt

Lisp/addattribute.lsp

@@ -7,6 +7,9 @@
 ;; (data/ils/allocations.json) und anschliessend werden
 ;; ausschliesslich die DWGs in genau diesem Verzeichnis bearbeitet.
 ;;
+;; Es gibt zwei Modi (Auswahl beim Befehlsaufruf):
+;;
+;; MODUS "Ergaenzen" (Vorgabe, bisheriges Verhalten)
 ;; Ablauf je JSON-Eintrag  "Blockname": {"TAG": "Wert", ...}:
 ;;   - <Blockname>.dwg im selben Verzeichnis wie die JSON oeffnen
 ;;   - je Attribut (TAG/Wert):
@@ -17,17 +20,35 @@
 ;;                                                 -> NUR ueberschreiben,
 ;;         wenn der JSON-Wert NICHT leer ("") ist. Ein leerer JSON-Wert
 ;;         loescht also nie einen bereits vorhandenen Wert.
+;;   - ATTDEFs, die in der JSON nicht vorkommen, bleiben unberuehrt.
+;;
+;; MODUS "Ersetzen" (die JSON ist die alleinige Quelle der Wahrheit)
+;;   - JSON-Wert wird IMMER gesetzt, auch ein leerer Wert (der Wert des
+;;     ATTDEF wird dann geleert)
+;;   - Tags, die in der DWG fehlen, werden neu angelegt
+;;   - ATTDEFs, deren Tag NICHT in der JSON steht, werden GELOESCHT
+;;   - vorhandene ATTDEFs werden dabei in-place geaendert, behalten also
+;;     Position, Texthoehe, Layer und Stil (im Unterschied zu
+;;     data/omniflo/2D/addattributes.py --replace, das alles neu stapelt)
+;;
+;; In beiden Modi gilt:
 ;;   - DWG nur dann speichern, wenn sich mindestens ein Attributwert
-;;     geaendert hat oder neu angelegt wurde (bessere Nachverfolgbarkeit
-;;     im Versionsvergleich). Falls durch dieses Skript geoeffnet, wird
-;;     die DWG anschliessend wieder geschlossen. War die DWG schon vorher
-;;     offen, bleibt sie offen.
+;;     geaendert hat, neu angelegt oder geloescht wurde (bessere
+;;     Nachverfolgbarkeit im Versionsvergleich). Falls durch dieses
+;;     Skript geoeffnet, wird die DWG anschliessend wieder geschlossen.
+;;     War die DWG schon vorher offen, bleibt sie offen.
+;;
+;; TIPP vor dem ersten "Ersetzen"-Lauf: mit ILS_ATTR_COLLECT
+;; (collect_attributes.lsp) den Ist-Zustand als allocations_collected.json
+;; schreiben und gegen allocations.json vergleichen - jeder Tag, der nur
+;; in der Collected-Datei steht, wird beim Ersetzen geloescht.
 ;;
 ;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
 ;;
 ;; Aufruf in BricsCAD:
 ;;   (load "C:/.../Lisp/addattribute.lsp")
-;;   ILS_ATTR_SYNC
+;;   ILS_ATTR_SYNC      ; fragt den Modus ab (Vorgabe: Ergaenzen)
+;;   ILS_ATTR_REPLACE   ; direkt Modus "Ersetzen" (mit Sicherheitsfrage)
 ;; ============================================================
 
 (vl-load-com)
@@ -60,10 +81,22 @@
 )
 
 ;; ------------------------------------------------------------
-;; Ein einzelnes ATTDEF aktualisieren (Ueberschreib-Regel)
+;; Statistik-Liste (anz-neu anz-gesetzt anz-geloescht):
+;; hat sich ueberhaupt etwas geaendert?
+;; (Achtung: eine Liste aus Nullen ist in LISP truthy, daher diese
+;;  explizite Pruefung statt eines einfachen if.)
+;; ------------------------------------------------------------
+(defun iad-stat-geaendert (stat)
+  (and stat (> (apply '+ stat) 0))
+)
+
+;; ------------------------------------------------------------
+;; Ein einzelnes ATTDEF aktualisieren
+;; ersetzen = T -> JSON-Wert immer setzen (auch leer)
+;; ersetzen = nil -> ein befuellter Wert bleibt bei leerem JSON-Wert stehen
 ;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde
 ;; ------------------------------------------------------------
-(defun iad-update-attdef (ent jsonwert / ed altwert)
+(defun iad-update-attdef (ent jsonwert ersetzen / ed altwert)
   (setq ed      (entget ent)
         altwert (cdr (assoc 1 ed))
   )
@@ -73,7 +106,7 @@
      (princ (strcat "\n    = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert)"))
      nil
     )
-    ((or (= (strlen altwert) 0) (> (strlen jsonwert) 0))
+    ((or ersetzen (= (strlen altwert) 0) (> (strlen jsonwert) 0))
      (entmod (subst (cons 1 jsonwert) (assoc 1 ed) ed))
      (princ (strcat "\n    - " (cdr (assoc 2 ed)) " = '" jsonwert "'"))
      t
@@ -103,19 +136,39 @@
 )
 
 ;; ------------------------------------------------------------
-;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
-;; attribs = (("TAG" . "Wert") ...)
-;; Rueckgabe: t, wenn mindestens ein Attribut geaendert/neu angelegt wurde
+;; Vorhandenes ATTDEF loeschen (nur Modus "Ersetzen")
 ;; ------------------------------------------------------------
-(defun iad-sync-attribs-in-current-doc (attribs / texthoehe layer ss anzahl i ent ed
-                                          tag wert pt vorhandene ypos gefunden paar geaendert)
+(defun iad-delete-attdef (ent / ed altwert)
+  (setq ed      (entget ent)
+        altwert (cdr (assoc 1 ed))
+  )
+  (if (null altwert) (setq altwert ""))
+  (princ (strcat "\n    x " (cdr (assoc 2 ed)) " = '" altwert "' (geloescht)"))
+  (entdel ent)
+)
+
+;; ------------------------------------------------------------
+;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
+;; attribs  = (("TAG" . "Wert") ...)
+;; ersetzen = T -> JSON ist die alleinige Quelle der Wahrheit
+;;                 (Werte immer setzen, ueberzaehlige ATTDEFs loeschen)
+;; Rueckgabe: Statistik-Liste (anz-neu anz-gesetzt anz-geloescht)
+;; ------------------------------------------------------------
+(defun iad-sync-attribs-in-current-doc (attribs ersetzen / texthoehe layer ss anzahl i ent ed
+                                          tag wert pt vorhandene ypos gefunden paar
+                                          json-tags anz-neu anz-gesetzt anz-geloescht)
   (setq texthoehe (ssg-cfg-or "ils_attribut" "texthoehe" 50.0)
         layer     (ssg-cfg-or "ils_attribut" "layer" "0")
         vorhandene nil
         ypos       0.0
-        geaendert  nil
+        anz-neu       0
+        anz-gesetzt   0
+        anz-geloescht 0
   )
-  ;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken
+  ;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken.
+  ;; Die Tags werden dabei ueber strcase normalisiert (ATTDEF-Tags haelt
+  ;; BricsCAD ohnehin in Grossschreibung), damit ein klein geschriebener
+  ;; JSON-Tag nicht als "fehlend" gilt und ein Duplikat erzeugt.
   (setq ss (ssget "X" '((0 . "ATTDEF"))))
   (if ss
     (progn
@@ -126,7 +179,8 @@
               tag (cdr (assoc 2 ed))
               pt  (cdr (assoc 10 ed))
         )
-        (setq vorhandene (cons (cons tag ent) vorhandene))
+        (if (null tag) (setq tag ""))
+        (setq vorhandene (cons (cons (strcase tag) ent) vorhandene))
         (if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt)))
         (setq i (1+ i))
       )
@@ -134,30 +188,172 @@
   )
   (setq ypos (- ypos (* texthoehe 2.0)))
 
+  (setq json-tags nil)
   (foreach paar attribs
-    (setq tag  (car paar)
+    (setq tag  (strcase (car paar))
           wert (cdr paar)
     )
     (if (null wert) (setq wert ""))
+    (setq json-tags (cons tag json-tags))
     (setq gefunden (cdr (assoc tag vorhandene)))
     (if gefunden
-      (if (iad-update-attdef gefunden wert) (setq geaendert t))
+      (if (iad-update-attdef gefunden wert ersetzen)
+        (setq anz-gesetzt (1+ anz-gesetzt))
+      )
       (progn
-        (iad-create-attdef tag wert ypos texthoehe layer)
+        (iad-create-attdef (car paar) wert ypos texthoehe layer)
         (setq ypos (- ypos (* texthoehe 2.0)))
-        (setq geaendert t)
+        (setq anz-neu (1+ anz-neu))
       )
     )
   )
-  geaendert
+
+  ;; Modus "Ersetzen": alle ATTDEFs entfernen, deren Tag nicht in der JSON steht
+  (if ersetzen
+    (foreach paar vorhandene
+      (if (not (member (car paar) json-tags))
+        (progn
+          (iad-delete-attdef (cdr paar))
+          (setq anz-geloescht (1+ anz-geloescht))
+        )
+      )
+    )
+  )
+
+  (list anz-neu anz-gesetzt anz-geloescht)
 )
 
 ;; ------------------------------------------------------------
-;; Hauptbefehl
+;; Sicherheitsfrage vor einem "Ersetzen"-Lauf
+;; Rueckgabe: T, wenn der Anwender ausdruecklich "Ja" gewaehlt hat
 ;; ------------------------------------------------------------
-(defun c:ILS_ATTR_SYNC ( / data-dir json-pfad dwg-dir daten orig-doc anzahl-aktualisiert
-                          anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag blockname attribs
-                          dwg-pfad bereits-offen fehler fehlende-liste name)
+(defun iad-ersetzen-bestaetigt (anzahl-eintraege)
+  (princ (strcat "\n[ATTR-SYNC] MODUS ERSETZEN: Attribute, die in der JSON nicht"
+                 "\n            aufgefuehrt sind, werden in den DWGs GELOESCHT."))
+  (initget "Ja Nein")
+  (= (getkword (strcat "\n" (itoa anzahl-eintraege)
+                       " JSON-Eintrag/-Eintraege jetzt verarbeiten? [Ja/Nein] <Nein>: "))
+     "Ja")
+)
+
+;; ------------------------------------------------------------
+;; Alle JSON-Eintraege abarbeiten
+;; daten    = (("Blockname" ("TAG" . "Wert") ...) ...)
+;; dwg-dir  = Verzeichnis der DWGs (= Verzeichnis der JSON)
+;; ersetzen = Modus (siehe iad-sync-attribs-in-current-doc)
+;; ------------------------------------------------------------
+(defun ils-attr-sync-eintraege (daten dwg-dir ersetzen / orig-doc anzahl-aktualisiert
+                                 anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag
+                                 blockname attribs dwg-pfad bereits-offen ergebnis
+                                 fehlende-liste name summe-neu summe-gesetzt summe-geloescht)
+  (setq orig-doc          (vla-get-ActiveDocument (vlax-get-acad-object))
+        anzahl-aktualisiert 0
+        anzahl-unveraendert 0
+        anzahl-fehler       0
+        anzahl-fehlt        0
+        fehlende-liste      nil
+        summe-neu           0
+        summe-gesetzt       0
+        summe-geloescht     0
+  )
+
+  (princ (strcat "\n[ATTR-SYNC] Modus: " (if ersetzen "Ersetzen" "Ergaenzen")))
+
+  (foreach eintrag daten
+    (setq blockname (car eintrag)
+          attribs   (cdr eintrag)
+          dwg-pfad  (strcat dwg-dir "/" blockname ".dwg")
+    )
+    (cond
+      ;; DWG zum JSON-Eintrag fehlt
+      ((not (findfile dwg-pfad))
+        (setq anzahl-fehlt (1+ anzahl-fehlt))
+        (setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste))
+      )
+
+      ;; Schutz: ein leerer JSON-Eintrag ("Blockname": {}) wuerde im Modus
+      ;; Ersetzen alle ATTDEFs der DWG loeschen. Das ist eher ein Fehler in
+      ;; der JSON als eine Absicht -> DWG unberuehrt lassen und warnen.
+      ((and ersetzen (null attribs))
+        (princ (strcat "\n[ATTR-SYNC] " blockname ".dwg uebersprungen: JSON-Eintrag"
+                       " ist leer (wuerde alle Attribute loeschen)."))
+        (setq anzahl-unveraendert (1+ anzahl-unveraendert))
+      )
+
+      (T
+        (princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ..."))
+        (setq bereits-offen (iad-find-open-doc dwg-pfad))
+        (setq ergebnis
+          (vl-catch-all-apply
+            (function
+              (lambda ( / stat)
+                (if bereits-offen
+                  (progn
+                    (vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
+                    (setq stat (iad-sync-attribs-in-current-doc attribs ersetzen))
+                  )
+                  (progn
+                    (command "_.OPEN" dwg-pfad)
+                    (setq stat (iad-sync-attribs-in-current-doc attribs ersetzen))
+                  )
+                )
+                (if (iad-stat-geaendert stat)
+                  (command "_.QSAVE")
+                  (princ "\n    (keine Aenderungen, DWG nicht gespeichert)")
+                )
+                (if (not bereits-offen) (command "_.CLOSE"))
+                stat
+              )
+            )
+            nil
+          )
+        )
+        (if (vl-catch-all-error-p ergebnis)
+          (progn
+            (princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: "
+                           (vl-catch-all-error-message ergebnis)))
+            (setq anzahl-fehler (1+ anzahl-fehler))
+          )
+          (progn
+            (setq summe-neu       (+ summe-neu       (nth 0 ergebnis))
+                  summe-gesetzt   (+ summe-gesetzt   (nth 1 ergebnis))
+                  summe-geloescht (+ summe-geloescht (nth 2 ergebnis))
+            )
+            (if (iad-stat-geaendert ergebnis)
+              (setq anzahl-aktualisiert (1+ anzahl-aktualisiert))
+              (setq anzahl-unveraendert (1+ anzahl-unveraendert))
+            )
+          )
+        )
+      )
+    )
+  )
+
+  (vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
+
+  (princ (strcat "\n[ATTR-SYNC] Fertig (Modus " (if ersetzen "Ersetzen" "Ergaenzen") "): "
+                 (itoa anzahl-aktualisiert) " DWG(s) aktualisiert, "
+                 (itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), "
+                 (itoa anzahl-fehler) " Fehler, "
+                 (itoa anzahl-fehlt) " nicht gefunden."))
+  (princ (strcat "\n[ATTR-SYNC] Attribute: " (itoa summe-neu) " neu angelegt, "
+                 (itoa summe-gesetzt) " Werte gesetzt, "
+                 (itoa summe-geloescht) " geloescht."))
+  (if fehlende-liste
+    (progn
+      (princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:")
+      (foreach name (reverse fehlende-liste)
+        (princ (strcat "\n    - " name))
+      )
+    )
+  )
+  (princ)
+)
+
+;; ------------------------------------------------------------
+;; Kernablauf: JSON aus DXFM_DATA/ils lesen und abarbeiten
+;; ------------------------------------------------------------
+(defun ils-attr-sync-run (ersetzen / data-dir json-pfad dwg-dir daten)
   (setq data-dir (getenv "DXFM_DATA"))
   (if (not data-dir)
     (progn
@@ -185,83 +381,30 @@
     )
   )
 
-  (setq orig-doc          (vla-get-ActiveDocument (vlax-get-acad-object))
-        anzahl-aktualisiert 0
-        anzahl-unveraendert 0
-        anzahl-fehler       0
-        anzahl-fehlt        0
-        fehlende-liste      nil
-  )
-
-  (foreach eintrag daten
-    (setq blockname (car eintrag)
-          attribs   (cdr eintrag)
-          dwg-pfad  (strcat dwg-dir "/" blockname ".dwg")
-    )
-    (if (findfile dwg-pfad)
-      (progn
-        (princ (strcat "\n[ATTR-SYNC] Bearbeite " blockname ".dwg ..."))
-        (setq bereits-offen (iad-find-open-doc dwg-pfad))
-        (setq fehler
-          (vl-catch-all-apply
-            (function
-              (lambda ( / geaendert)
-                (if bereits-offen
-                  (progn
-                    (vlax-put-property (vlax-get-acad-object) 'ActiveDocument bereits-offen)
-                    (setq geaendert (iad-sync-attribs-in-current-doc attribs))
-                  )
-                  (progn
-                    (command "_.OPEN" dwg-pfad)
-                    (setq geaendert (iad-sync-attribs-in-current-doc attribs))
-                  )
-                )
-                (if geaendert
-                  (command "_.QSAVE")
-                  (princ "\n    (keine Aenderungen, DWG nicht gespeichert)")
-                )
-                (if (not bereits-offen) (command "_.CLOSE"))
-                geaendert
-              )
-            )
-            nil
-          )
-        )
-        (if (vl-catch-all-error-p fehler)
-          (progn
-            (princ (strcat "\n[ATTR-SYNC] FEHLER bei " blockname ".dwg: "
-                           (vl-catch-all-error-message fehler)))
-            (setq anzahl-fehler (1+ anzahl-fehler))
-          )
-          (if fehler
-            (setq anzahl-aktualisiert (1+ anzahl-aktualisiert))
-            (setq anzahl-unveraendert (1+ anzahl-unveraendert))
-          )
-        )
-      )
-      (progn
-        (setq anzahl-fehlt (1+ anzahl-fehlt))
-        (setq fehlende-liste (cons (strcat blockname ".dwg") fehlende-liste))
-      )
-    )
-  )
-
-  (vlax-put-property (vlax-get-acad-object) 'ActiveDocument orig-doc)
-
-  (princ (strcat "\n[ATTR-SYNC] Fertig: " (itoa anzahl-aktualisiert) " DWG(s) aktualisiert, "
-                 (itoa anzahl-unveraendert) " ueberprueft (keine Aenderungen), "
-                 (itoa anzahl-fehler) " Fehler, "
-                 (itoa anzahl-fehlt) " nicht gefunden."))
-  (if fehlende-liste
-    (progn
-      (princ "\n[ATTR-SYNC] WARNUNG: DWG nicht gefunden fuer:")
-      (foreach name (reverse fehlende-liste)
-        (princ (strcat "\n    - " name))
-      )
-    )
+  (if (and ersetzen (not (iad-ersetzen-bestaetigt (length daten))))
+    (princ "\n[ATTR-SYNC] Abgebrochen - keine Aenderungen.")
+    (ils-attr-sync-eintraege daten dwg-dir ersetzen)
   )
   (princ)
 )
 
-(princ "\naddattribute.lisp geladen. Befehl: ILS_ATTR_SYNC")
+;; ------------------------------------------------------------
+;; Hauptbefehl - Modus wird interaktiv abgefragt
+;; (Grossbuchstaben in initget = zulaessige Abkuerzungen: ERG / ERS)
+;; ------------------------------------------------------------
+(defun c:ILS_ATTR_SYNC ( / modus)
+  (initget "ERGaenzen ERSetzen")
+  (setq modus (getkword "\nModus waehlen [ERGaenzen/ERSetzen] <ERGaenzen>: "))
+  (if (not modus) (setq modus "ERGaenzen"))
+  (ils-attr-sync-run (= modus "ERSetzen"))
+)
+
+;; ------------------------------------------------------------
+;; Direktbefehl fuer den Modus "Ersetzen" (Sicherheitsfrage bleibt)
+;; ------------------------------------------------------------
+(defun c:ILS_ATTR_REPLACE ()
+  (ils-attr-sync-run T)
+)
+
+(princ "\naddattribute.lisp geladen. Befehle: ILS_ATTR_SYNC, ILS_ATTR_REPLACE")
 (princ)