From d21f0acb4e38153a1261ac9b25a952199c401186 Mon Sep 17 00:00:00 2001 From: Yuelin Wang Date: Fri, 24 Jul 2026 13:31:03 +0200 Subject: [PATCH] feat: ILS-Bloecke ueber eindeutige 2D/3D-Namen laden + Auto-Layer Zentrale Namensaufloesung (ssg-ils-datei-und-name, dual-schema: neu data/ils/_.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 --- Lisp/Gefaellestrecke.lsp | 28 ++++---- Lisp/ssg_core.lsp | 148 ++++++++++++++++++++++++--------------- Lisp/vf_core.lsp | 33 +++++---- 3 files changed, 126 insertions(+), 83 deletions(-) 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)