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

[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

Browse Source
This commit is contained in:
Simon Hensch
2026-08-28 10:10:19 +02:00
parent 43896a28f5
commit df2b4f1709
141 changed files with 243 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/addattribute.lsp
+243 -100
View File
@@ -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)