273 lines
9.4 KiB
Common Lisp
273 lines
9.4 KiB
Common Lisp
;; ============================================================
|
|
;; addattribute.lisp
|
|
;; Synchronisiert ATTDEF-Attribute in den ILS-Block-DWGs mit den
|
|
;; Werten aus allocations.json.
|
|
;;
|
|
;; Es wird zwischen data/ils/2D und data/ils/3D unterschieden: nach
|
|
;; Auswahl des Verzeichnisses wird die dortige allocations.json
|
|
;; gelesen (data/ils/<2D|3D>/allocations.json) und anschliessend
|
|
;; werden ausschliesslich die DWGs in genau diesem Verzeichnis
|
|
;; bearbeitet.
|
|
;;
|
|
;; Ablauf je JSON-Eintrag "Blockname": {"TAG": "Wert", ...}:
|
|
;; - <Blockname>.dwg im selben Verzeichnis wie die JSON oeffnen
|
|
;; - je Attribut (TAG/Wert):
|
|
;; - ATTDEF mit diesem Tag existiert nicht -> neu anlegen,
|
|
;; Vorgabewert = JSON-Wert (auch wenn dieser leer ist)
|
|
;; - ATTDEF existiert, ist aber leer -> mit JSON-Wert befuellen
|
|
;; - ATTDEF existiert und ist bereits befuellt
|
|
;; -> NUR ueberschreiben,
|
|
;; wenn der JSON-Wert NICHT leer ("") ist. Ein leerer JSON-Wert
|
|
;; loescht also nie einen bereits vorhandenen Wert.
|
|
;; - 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.
|
|
;;
|
|
;; Voraussetzung: DXFM_DATA ist gesetzt (siehe bin/setenv.bat).
|
|
;;
|
|
;; Aufruf in BricsCAD:
|
|
;; (load "C:/.../data/ils/2D/addattribute.lisp")
|
|
;; ILS_ATTR_SYNC
|
|
;; ============================================================
|
|
|
|
(vl-load-com)
|
|
|
|
;; ssg_core.lsp (JSON-Parser ssg-cfg-parse-nested) sicherstellen,
|
|
;; falls das Menue/die Kern-Module noch nicht geladen wurden.
|
|
(if (not (car (atoms-family 1 '("SSG-CFG-PARSE-NESTED"))))
|
|
(if (getenv "DXFM_LISP")
|
|
(load (strcat (vl-string-translate "\\" "/" (getenv "DXFM_LISP")) "/ssg_core.lsp"))
|
|
)
|
|
)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Bereits offenes Dokument mit gegebenem Pfad suchen (oder nil)
|
|
;; ------------------------------------------------------------
|
|
(defun iad-find-open-doc (dwg-pfad / docs anzahl i doc full treffer)
|
|
(setq docs (vla-get-Documents (vlax-get-acad-object))
|
|
anzahl (vla-get-Count docs)
|
|
i 0
|
|
treffer nil
|
|
dwg-pfad (strcase (vl-string-translate "\\" "/" dwg-pfad))
|
|
)
|
|
(while (and (< i anzahl) (not treffer))
|
|
(setq doc (vla-item docs i))
|
|
(setq full (strcase (vl-string-translate "\\" "/" (vla-get-FullName doc))))
|
|
(if (= full dwg-pfad) (setq treffer doc))
|
|
(setq i (1+ i))
|
|
)
|
|
treffer
|
|
)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Ein einzelnes ATTDEF aktualisieren (Ueberschreib-Regel)
|
|
;; Rueckgabe: t, wenn der Wert tatsaechlich geaendert wurde
|
|
;; ------------------------------------------------------------
|
|
(defun iad-update-attdef (ent jsonwert / ed altwert)
|
|
(setq ed (entget ent)
|
|
altwert (cdr (assoc 1 ed))
|
|
)
|
|
(if (null altwert) (setq altwert ""))
|
|
(cond
|
|
((equal altwert jsonwert)
|
|
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert)"))
|
|
nil
|
|
)
|
|
((or (= (strlen altwert) 0) (> (strlen jsonwert) 0))
|
|
(entmod (subst (cons 1 jsonwert) (assoc 1 ed) ed))
|
|
(princ (strcat "\n - " (cdr (assoc 2 ed)) " = '" jsonwert "'"))
|
|
t
|
|
)
|
|
(t
|
|
(princ (strcat "\n = " (cdr (assoc 2 ed)) " = '" altwert "' (unveraendert, JSON-Wert leer)"))
|
|
nil
|
|
)
|
|
)
|
|
)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Neues (unsichtbares) ATTDEF anlegen
|
|
;; ------------------------------------------------------------
|
|
(defun iad-create-attdef (tag wert ypos texthoehe layer)
|
|
(entmake (list
|
|
'(0 . "ATTDEF")
|
|
(cons 8 layer)
|
|
(cons 10 (list 0.0 ypos 0.0))
|
|
(cons 40 texthoehe)
|
|
(cons 1 wert)
|
|
(cons 3 tag)
|
|
(cons 2 tag)
|
|
'(70 . 1)
|
|
))
|
|
(princ (strcat "\n + " tag " = '" wert "' (neu angelegt)"))
|
|
)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Alle Attribute eines JSON-Eintrags im aktiven Dokument abgleichen
|
|
;; attribs = (("TAG" . "Wert") ...)
|
|
;; Rueckgabe: t, wenn mindestens ein Attribut geaendert/neu angelegt wurde
|
|
;; ------------------------------------------------------------
|
|
(defun iad-sync-attribs-in-current-doc (attribs / texthoehe layer ss anzahl i ent ed
|
|
tag wert pt vorhandene ypos gefunden paar geaendert)
|
|
(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
|
|
)
|
|
;; Vorhandene ATTDEFs einsammeln (Tag -> Entity) und tiefsten Y-Wert merken
|
|
(setq ss (ssget "X" '((0 . "ATTDEF"))))
|
|
(if ss
|
|
(progn
|
|
(setq i 0 anzahl (sslength ss))
|
|
(while (< i anzahl)
|
|
(setq ent (ssname ss i)
|
|
ed (entget ent)
|
|
tag (cdr (assoc 2 ed))
|
|
pt (cdr (assoc 10 ed))
|
|
)
|
|
(setq vorhandene (cons (cons tag ent) vorhandene))
|
|
(if (and pt (< (cadr pt) ypos)) (setq ypos (cadr pt)))
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
(setq ypos (- ypos (* texthoehe 2.0)))
|
|
|
|
(foreach paar attribs
|
|
(setq tag (car paar)
|
|
wert (cdr paar)
|
|
)
|
|
(if (null wert) (setq wert ""))
|
|
(setq gefunden (cdr (assoc tag vorhandene)))
|
|
(if gefunden
|
|
(if (iad-update-attdef gefunden wert) (setq geaendert t))
|
|
(progn
|
|
(iad-create-attdef tag wert ypos texthoehe layer)
|
|
(setq ypos (- ypos (* texthoehe 2.0)))
|
|
(setq geaendert t)
|
|
)
|
|
)
|
|
)
|
|
geaendert
|
|
)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; Hauptbefehl
|
|
;; ------------------------------------------------------------
|
|
(defun c:ILS_ATTR_SYNC ( / data-dir json-pfad dwg-dir dwg-unterverz daten orig-doc anzahl-aktualisiert
|
|
anzahl-unveraendert anzahl-fehler anzahl-fehlt eintrag blockname attribs
|
|
dwg-pfad bereits-offen fehler fehlende-liste name)
|
|
(setq data-dir (getenv "DXFM_DATA"))
|
|
(if (not data-dir)
|
|
(progn
|
|
(alert "DXFM_DATA ist nicht gesetzt.\nBitte zuerst bin/setenv.bat ausfuehren.")
|
|
(exit)
|
|
)
|
|
)
|
|
(setq data-dir (vl-string-translate "\\" "/" data-dir))
|
|
|
|
(initget "2D 3D")
|
|
(setq dwg-unterverz (getkword "\nDWG-Verzeichnis waehlen [2D/3D] <2D>: "))
|
|
(if (not dwg-unterverz) (setq dwg-unterverz "2D"))
|
|
(setq dwg-dir (strcat data-dir "/ils/" dwg-unterverz)
|
|
json-pfad (strcat dwg-dir "/allocations.json")
|
|
)
|
|
(if (not (findfile json-pfad))
|
|
(progn
|
|
(alert (strcat "JSON nicht gefunden:\n" json-pfad))
|
|
(exit)
|
|
)
|
|
)
|
|
|
|
(setq daten (ssg-cfg-parse-nested (ssg-read-file-lines json-pfad)))
|
|
(if (not daten)
|
|
(progn
|
|
(alert "JSON konnte nicht gelesen werden oder ist leer.")
|
|
(exit)
|
|
)
|
|
)
|
|
|
|
(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))
|
|
)
|
|
)
|
|
)
|
|
(princ)
|
|
)
|
|
|
|
(princ "\naddattribute.lisp geladen. Befehl: ILS_ATTR_SYNC")
|
|
(princ)
|