diff --git a/Lisp/Gefaellestrecke.lsp b/Lisp/Gefaellestrecke.lsp
index 90b2d2d..7f622e3 100644
--- a/Lisp/Gefaellestrecke.lsp
+++ b/Lisp/Gefaellestrecke.lsp
@@ -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)))
diff --git a/Lisp/ssg_core.lsp b/Lisp/ssg_core.lsp
index 8aff964..5e43d28 100644
--- a/Lisp/ssg_core.lsp
+++ b/Lisp/ssg_core.lsp
@@ -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/_.dwg -> realname _
+;; (Fallback _3D, falls die aktuelle Dim-Datei fehlt)
+;; ALT (Unterordner): data/ils//.dwg -> realname
+;; (Fallback data/ils/3D/.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 (_) -> einmal laden, kein Redefine.
+;; ALT-Schema: Name = (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"
diff --git a/Lisp/vf_core.lsp b/Lisp/vf_core.lsp
index 812acad..84ae4b2 100644
--- a/Lisp/vf_core.lsp
+++ b/Lisp/vf_core.lsp
@@ -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)