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

feat: ILS-Bloecke ueber eindeutige 2D/3D-Namen laden + Auto-Layer

Browse Source 
Zentrale Namensaufloesung (ssg-ils-datei-und-name, dual-schema: neu data/ils/<name>_<dim>.dwg mit eindeutigem In-Zeichnungs-Namen, alt Unterordner als Fallback). ensure-block-loaded liefert den aufgeloesten Namen; die insert-Helfer weisen blockname neu zu und setzen die INSERT-Referenz automatisch auf die eigene Ebene des Blocks (ssg-ils-block-auf-ebene, legt sie bei Bedarf an).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Yuelin Wang
2026-07-24 13:31:03 +02:00
parent 60c20519a0
commit d21f0acb4e
3 changed files with 126 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/Gefaellestrecke.lsp
+14 -14
View File
@@ -115,13 +115,13 @@
;; --- Block als einzelne DWG-Datei aus block-pfad laden ---
(if (null (car (atoms-family 1 '("ENSURE-BLOCK-LOADED"))))
(defun ensure-block-loaded (blockname / )
;; Zentraler Loader (aktuelle Dimension + 3D-Fallback, Neudefinition bei
;; Dimensionswechsel). Meldung nur bei Fehlschlag.
(if (not (ssg-ils-block-laden blockname))
(progn
(princ (ssg-textf "gf-fehler-blockdatei-fehlt" (list blockname)))
)
(defun ensure-block-loaded (blockname / real)
;; Zentraler Loader; liefert den IN-ZEICHNUNGS-NAMEN zurueck (2D/3D
;; eindeutig) oder nil bei Fehlschlag.
(setq real (ssg-ils-block-laden blockname))
(if (null real)
(progn (princ (ssg-textf "gf-fehler-blockdatei-fehlt" (list blockname))) nil)
real
)
)
)
@@ -239,7 +239,7 @@
block-obj temp-obj ks-data ks-ein ks-aus
rad-h chv shv ein-x ein-y ein-z dx-loc dy-loc dz-loc
offset ausgang)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "gf-fehler-block-fehlt" (list blockname)))
@@ -302,7 +302,7 @@
(if (<= laenge 0.1)
(progn (princ (ssg-text "gf-laenge-null-uebersprungen")) startpunkt)
(progn
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(setq scale (/ (float laenge) 1000.0))
(setq rad-v (* (float winkel) (/ pi 180.0)))
(setq rad-h (* (float hz) (/ pi 180.0)))
@@ -343,7 +343,7 @@
ks-ein-raw ks-aus-raw
ein-x ein-y ein-z aus-x aus-y aus-z
dx dz ins-pt)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(setq rad-v (* (float winkel) (/ pi 180.0)))
(setq rad-h (* (float hz) (/ pi 180.0)))
(setq chv (cos rad-h) shv (sin rad-h) cvv (cos rad-v) svv (sin rad-v))
@@ -517,7 +517,7 @@
(if (<= laenge 0.1)
(progn (princ (ssg-text "gf-laenge-null-uebersprungen")) pt)
(progn
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(setq scale (/ (float laenge) 1000.0))
(setq chz (cos (* (float hz-grad) (/ pi 180.0))))
(setq shz (sin (* (float hz-grad) (/ pi 180.0))))
@@ -549,7 +549,7 @@
;; dz: vertikaler Offset im Block (mm, 0 fuer gerade Bloecke)
(defun gf-insert-hz-with-ks (blockname pt hz-grad vert-grad dx dz /
chz shz cv sv block-obj endpunkt)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(setq chz (cos (* (float hz-grad) (/ pi 180.0))))
(setq shz (sin (* (float hz-grad) (/ pi 180.0))))
(setq cv (cos (* (float vert-grad) (/ pi 180.0))))
@@ -581,7 +581,7 @@
temp-obj block-obj ks-data ks-ein ks-aus
p-ein p-aus p-ein-rot p-aus-rot
offset ausgang)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "gf-fehler-block-fehlt-ausruf" (list blockname)))
@@ -672,7 +672,7 @@
blockname temp-obj ks-data
ks-ein-pos ks-aus-pos dx dz)
(setq blockname (gf-bogen-blockname bwinkel bseite))
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "gf-warnung-block-fehlt-nullwerte" (list blockname)))
Lisp/ssg_core.lsp
+92 -56
View File
@@ -329,71 +329,107 @@
"/data/ils/"))
(t nil)))
;; Liefert den vollstaendigen .dwg-Pfad zu einem ILS-Block anhand der
;; aktuellen Dimension (siehe ssg-ils-dim-aktuell). Faellt automatisch auf die
;; 3D-Variante zurueck, wenn der Block in der aktuellen Dimension (noch) nicht
;; existiert - so nutzen z.B. Vario_Motorstation/-Umlenkstation im 2D-Modus
;; vorlaeufig die 3D-Datei.
;; Rueckgabe: Pfad-String oder nil (Block weder in Dim noch in 3D gefunden).
(defun ssg-ils-block-datei (blockname / basis dim datei datei3d)
;; Liefert (datei . realname): vollstaendiger .dwg-Pfad UND der Name, unter dem
;; der Block in der Zeichnung erscheint. Zwei Schemata (uebergangsweise beide):
;; NEU (flach, eindeutig): data/ils/<base>_<dim>.dwg -> realname <base>_<dim>
;; (Fallback <base>_3D, falls die aktuelle Dim-Datei fehlt)
;; ALT (Unterordner): data/ils/<dim>/<base>.dwg -> realname <base>
;; (Fallback data/ils/3D/<base>.dwg)
;; Rueckgabe nil, wenn nichts gefunden.
(defun ssg-ils-datei-und-name (base / basis dim f)
(setq basis (ssg-ils-basis))
(if (null basis)
nil
(progn
(setq dim (ssg-ils-dim-aktuell))
(setq datei (strcat basis dim "/" blockname ".dwg"))
(setq datei3d (strcat basis "3D/" blockname ".dwg"))
(cond
((findfile datei) datei) ; aktuelle Dimension
((findfile datei3d) datei3d) ; Fallback: 3D-Variante
(t nil))
)
)
)
((findfile (setq f (strcat basis base "_" dim ".dwg"))) (cons f (strcat base "_" dim)))
((findfile (setq f (strcat basis base "_3D.dwg"))) (cons f (strcat base "_3D")))
((findfile (setq f (strcat basis dim "/" base ".dwg"))) (cons f base))
((findfile (setq f (strcat basis "3D/" base ".dwg"))) (cons f base))
(t nil)))))
;; Merker: welche Dimension ("2D"/"3D") aktuell je Blockname geladen ist.
;; (blockname . dim). Verhindert unnoetiges Neu-Definieren bei gleicher Dim.
;; Nur der Dateipfad (fuer Aufrufer, die per Pfad einfuegen, z.B. Sensoren).
(defun ssg-ils-block-datei (base / dn)
(setq dn (ssg-ils-datei-und-name base))
(if dn (car dn) nil))
;; Merker: welche Dimension je (ALT-Schema) Blockname geladen ist.
(if (not (boundp '*ssg-ils-dim-geladen*)) (setq *ssg-ils-dim-geladen* '()))
;; Stellt sicher, dass die Block-DEFINITION 'blockname' in der AKTUELLEN
;; Dimension geladen ist. Weil 2D- und 3D-Datei denselben Blocknamen tragen,
;; muss bei einem Dimensionswechsel aus der Zieldatei NEU definiert werden -
;; sonst bliebe die alte Definition (z.B. 3D) erhalten.
;; Rueckgabe: T (geladen/vorhanden) oder nil (Datei nicht gefunden).
(defun ssg-ils-block-laden (blockname / dim exists datei temp-obj osm areq adia)
(setq dim (ssg-ils-dim-aktuell))
(setq exists (tblsearch "BLOCK" blockname))
(cond
;; Schon in der gewuenschten Dimension geladen -> nichts tun.
((and exists (equal (cdr (assoc blockname *ssg-ils-dim-geladen*)) dim)) T)
(t
(setq datei (ssg-ils-block-datei blockname))
(if (null datei)
nil
(progn
(if exists
;; Existiert (evtl. andere Dimension) -> aus Datei NEU definieren.
;; "_Y" beantwortet die Redefine-Abfrage; danach wird die eigentliche
;; Einfuegung abgebrochen (die Neudefinition ist bereits wirksam).
(progn
(setq areq (getvar "ATTREQ") adia (getvar "ATTDIA") osm (getvar "OSMODE"))
(setvar "ATTREQ" 0)(setvar "ATTDIA" 0)(setvar "OSMODE" 0)
(command "_.-INSERT" (strcat blockname "=" datei) "_Y")
;; laufende Einfuegung abbrechen (Neudefinition ist bereits wirksam)
(if (> (getvar "CMDACTIVE") 0) (command))
(if (> (getvar "CMDACTIVE") 0) (command))
(setvar "OSMODE" osm)(setvar "ATTREQ" areq)(setvar "ATTDIA" adia))
;; Neu -> bewaehrter COM-Weg (kein Redefine-Prompt).
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj)))
;; Merker aktualisieren (alten Dim-Eintrag dieses Blocks ersetzen).
(setq *ssg-ils-dim-geladen*
(cons (cons blockname dim)
(vl-remove-if (function (lambda (p) (equal (car p) blockname)))
*ssg-ils-dim-geladen*)))
T)))))
;; Stellt sicher, dass der Block geladen ist, und liefert den IN-ZEICHNUNGS-
;; NAMEN zurueck, unter dem einzufuegen ist (bzw. nil bei Fehler).
;; NEU-Schema: eindeutiger Name (<base>_<dim>) -> einmal laden, kein Redefine.
;; ALT-Schema: Name = <base> (2D/3D teilen den Namen) -> bei Dimwechsel aus
;; der Datei neu definieren (Redefine).
(defun ssg-ils-block-laden (base / dn datei realname dim temp-obj osm areq adia)
(setq dn (ssg-ils-datei-und-name base))
(if (null dn)
nil
(progn
(setq datei (car dn) realname (cdr dn))
(if (/= realname base)
;; ---- NEU-Schema (eindeutiger Name) ----
(progn
(if (not (tblsearch "BLOCK" realname))
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj)))
realname)
;; ---- ALT-Schema (gemeinsamer Name, Uebergang) ----
(progn
(setq dim (ssg-ils-dim-aktuell))
(if (not (and (tblsearch "BLOCK" base)
(equal (cdr (assoc base *ssg-ils-dim-geladen*)) dim)))
(if (tblsearch "BLOCK" base)
(progn
(setq areq (getvar "ATTREQ") adia (getvar "ATTDIA") osm (getvar "OSMODE"))
(setvar "ATTREQ" 0)(setvar "ATTDIA" 0)(setvar "OSMODE" 0)
(command "_.-INSERT" (strcat base "=" datei) "_Y")
(if (> (getvar "CMDACTIVE") 0) (command))
(if (> (getvar "CMDACTIVE") 0) (command))
(setvar "OSMODE" osm)(setvar "ATTREQ" areq)(setvar "ATTDIA" adia))
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0)) datei 1.0 1.0 1.0 0))
(vla-Delete temp-obj))))
(setq *ssg-ils-dim-geladen*
(cons (cons base dim)
(vl-remove-if (function (lambda (p) (equal (car p) base)))
*ssg-ils-dim-geladen*)))
base)))))
;; Ermittelt die "eigene" Ebene eines geladenen Blocks: haeufigste Ebene (ausser
;; "0") seiner Definition-Entities; nil, wenn nur "0".
(defun ssg-ils-block-ebene (realname / blocks blk e lay pair counts best best-n c)
(if (and realname (tblsearch "BLOCK" realname))
(progn
(setq blocks (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq blk (vla-item blocks realname))
(setq counts '())
(vlax-for e blk
(setq lay (vla-get-Layer e))
(if (and lay (/= lay "0"))
(progn
(setq pair (assoc lay counts))
(if pair
(setq counts (subst (cons lay (1+ (cdr pair))) pair counts))
(setq counts (cons (cons lay 1) counts))))))
(setq best nil best-n 0)
(foreach c counts (if (> (cdr c) best-n) (setq best (car c) best-n (cdr c))))
best)
nil))
;; Setzt die INSERT-Referenz (VLA-Objekt) auf die eigene Ebene ihres Blocks
;; (legt die Ebene an, falls noetig). No-op, wenn keine eigene Ebene ermittelbar.
(defun ssg-ils-block-auf-ebene (obj realname / eb)
(setq eb (ssg-ils-block-ebene realname))
(if (and eb obj)
(progn
(if (not (tblsearch "LAYER" eb)) (ssg-make-layer eb 7 nil))
(vl-catch-all-apply (function (lambda () (vla-put-Layer obj eb))))))
obj)
;; ------------------------------------------------------------
;; DIMENSIONS-XDATA (2D/3D) je Block - App "SSG_DIM"
Lisp/vf_core.lsp
+20 -13
View File
@@ -258,11 +258,13 @@
;; ============================================================
;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION
;; ============================================================
(defun ensure-block-loaded (blockname / )
;; Zentraler Loader (aktuelle Dimension + 3D-Fallback, Neudefinition bei
;; Dimensionswechsel). Meldung nur bei Fehlschlag.
(if (not (ssg-ils-block-laden blockname))
(princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname)))
(defun ensure-block-loaded (blockname / real)
;; Zentraler Loader; liefert den IN-ZEICHNUNGS-NAMEN zurueck, unter dem der
;; Block einzufuegen ist (2D/3D eindeutig), oder nil bei Fehlschlag.
(setq real (ssg-ils-block-laden blockname))
(if (null real)
(progn (princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname))) nil)
real
)
)
@@ -450,7 +452,7 @@
(exit)
)
)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
@@ -475,6 +477,7 @@
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(ssg-ils-block-auf-ebene block-obj blockname)
(if (> (abs hz) 0.0001)
(vla-TransformBy block-obj (vlax-tmatrix
(list (list chv (- shv) 0 0)
@@ -522,7 +525,7 @@
P-ein xe ye ze P-aus xu-aus yu-aus zu-aus
R R-Pein R-Paus tx ty tz T4
P-out xu-out yu-out zu-out)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
@@ -552,6 +555,7 @@
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(ssg-ils-block-auf-ebene block-obj blockname)
;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
(setq f-ein (ks-frame-extract ks-ein-raw)
f-aus (ks-frame-extract ks-aus-raw))
@@ -610,7 +614,7 @@
xe ye ze P-ein P-aus xu-aus yu-aus zu-aus
R P-xyref P-zref R-xyref R-zref tx ty tz T4
R-Paus P-out xu-out yu-out zu-out)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
@@ -640,6 +644,7 @@
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(ssg-ils-block-auf-ebene block-obj blockname)
;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
(setq f-ein (ks-frame-extract ks-ein-raw)
f-aus (ks-frame-extract ks-aus-raw))
@@ -693,7 +698,7 @@
;; ============================================================
;; Masse (KS_EIN->KS_AUS als (dx dy dz)) eines Elements aus dem Block ziehen.
(defun vf-element-masse (blockname / temp-obj ks-data ke ka)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
nil
(progn
@@ -713,7 +718,7 @@
;; oder gerade). Wird genutzt, um KS_EIN so zu drehen, dass KS_AUS entlang hz
;; zeigt: ein-hz = hz - plan-turn. Fallback 90 (Vorgabe fuer 90-Grad-Element).
(defun vf-element-plan-turn (blockname / temp-obj ks-data fe fa)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
90.0
(progn
@@ -734,7 +739,7 @@
;; vx / vy : KS_AUS.origin - KS_EIN.origin (Block-XY)
;; Damit laesst sich die KS_AUS-Lage + Achsrichtung analytisch vorausberechnen.
(defun vf-element-ks-info (blockname / temp-obj ks-data fe fa)
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
nil
(progn
@@ -780,7 +785,7 @@
startpunkt
)
(progn
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
@@ -796,6 +801,7 @@
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname scale 1.0 1.0 0))
(ssg-ils-block-auf-ebene block-obj blockname)
(setq matrix (list
(list (* chv cvv) (- shv) (* chv svv) 0)
(list (* shv cvv) chv (* shv svv) 0)
@@ -843,7 +849,7 @@
startpunkt
)
(progn
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek-abgebrochen" (list blockname)))
@@ -887,6 +893,7 @@
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(ssg-ils-block-auf-ebene block-obj blockname)
(setq matrix (list
(list (* chv cvv) (- shv) (* chv svv) 0)
(list (* shv cvv) chv (* shv svv) 0)