[CHANGE] Verzeichnisse ILS 2d und 3d zusammengeführt und Funktionen entsprechend angepasst; TODO: Vario auf/ab Bögen schalten noch nicht korrekt zwischen 2d und 3d hin und her; TODO: Omniflo Verzeichnisse 2d/3d entsprechend genau so zusammenführen

This commit is contained in:
2026-07-24 13:00:33 +02:00
parent 60c20519a0
commit b16c2e0fa1
160 changed files with 211 additions and 153 deletions
+30 -25
View File
@@ -57,21 +57,21 @@
(if (null *gf-L-ohne-as-es*) (setq *gf-L-ohne-as-es* nil))
(if (null *gf-sum-dz-bogen*) (setq *gf-sum-dz-bogen* 0.0))
;; DXFM_DIM lesen; 2D wird auf 3D korrigiert (Gefaellestrecke benoetigt Z-Geometrie)
(setq *gf-dxfm-dim* (getenv "DXFM_DIM"))
(if (or (not (= (type *gf-dxfm-dim*) 'STR)) (= *gf-dxfm-dim* "2D"))
(setq *gf-dxfm-dim* "3D"))
;; Block-Pfad: data/ils/3D/ wenn DXFM_DIM nicht gesetzt oder 2D
;; Bloecke liegen seit dem Flach-Refactor direkt unter data/ils/ (die Dimension
;; steckt im Dateinamen bzw. Blocknamen als Suffix _2D/_3D, siehe ssg_core.lsp).
;; Gefaellestrecke folgt der aktuellen Dimension (ssg-ils-dim-aktuell) mit
;; 3D-Fallback; das Laden erfolgt zentral ueber ensure-block-loaded.
;; block-pfad dient nur noch der Info-Ausgabe (Basisverzeichnis).
(if (null block-pfad)
(setq block-pfad
(cond
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
"/data/ils/" *gf-dxfm-dim* "/"))
"/data/ils/"))
((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/data/ils/" *gf-dxfm-dim* "/"))
"/data/ils/"))
(t nil)
)
)
@@ -116,13 +116,18 @@
;; --- 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.
;; Zentraler Loader (flache Ablage). Laedt den Block in der AKTUELLEN Dimension
;; (ssg-ils-dim-aktuell: *ssg-ils-dim*-Override -> DXFM_DIM) mit automatischem
;; 3D-Fallback, sodass 2D- und 3D-Aufbau gleichermassen funktionieren. Laedt
;; den Block unter seinem effektiven, dim-suffigierten Namen und GIBT DIESEN
;; ZURUECK, damit Aufrufer ihn zum Einfuegen verwenden. Meldung nur bei
;; Fehlschlag.
(if (not (ssg-ils-block-laden blockname))
(progn
(princ (ssg-textf "gf-fehler-blockdatei-fehlt" (list blockname)))
)
)
(ssg-ils-blockname blockname)
)
)
@@ -239,7 +244,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 +307,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 +348,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))
@@ -440,18 +445,18 @@
;; --- Bibliothek initialisieren: AS/ES-Masse aus einzelnen DWG-Dateien extrahieren ---
(if (null (car (atoms-family 1 '("GF-INIT-BIBLIOTHEK"))))
(defun gf-init-bibliothek ( / temp-obj ks-data ks-ein ks-aus)
(defun gf-init-bibliothek ( / temp-obj ks-data ks-ein ks-aus as-blk es-blk)
(if *lib-initialized*
t
(progn
;; AS-Block laden und Masse extrahieren
(ensure-block-loaded "AS_Element_90_links")
(if (tblsearch "BLOCK" "AS_Element_90_links")
;; AS-Block laden und Masse extrahieren (effektiver, dim-suffigierter Name)
(setq as-blk (ensure-block-loaded "AS_Element_90_links"))
(if (tblsearch "BLOCK" as-blk)
(progn
(setq temp-obj
(vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"AS_Element_90_links" 1.0 1.0 1.0 0))
as-blk 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(vla-Delete temp-obj)
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
@@ -465,14 +470,14 @@
)
)
)
;; ES-Block laden und Masse extrahieren
(ensure-block-loaded "ES_Element_90_links")
(if (tblsearch "BLOCK" "ES_Element_90_links")
;; ES-Block laden und Masse extrahieren (effektiver, dim-suffigierter Name)
(setq es-blk (ensure-block-loaded "ES_Element_90_links"))
(if (tblsearch "BLOCK" es-blk)
(progn
(setq temp-obj
(vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"ES_Element_90_links" 1.0 1.0 1.0 0))
es-blk 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(vla-Delete temp-obj)
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
@@ -517,7 +522,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 +554,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 +586,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 +677,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)))
+13 -11
View File
@@ -19,17 +19,19 @@
;; DXFM_DIM sicher lesen (type-Guard gegen nicht-String Rueckgabewerte)
(setq *ki-dxfm-dim* (getenv "DXFM_DIM"))
(if (not (= (type *ki-dxfm-dim*) 'STR)) (setq *ki-dxfm-dim* "3D"))
;; Modul-eigener Block-Pfad (nicht in globalem block-pfad speichern,
;; da GF/VF stets 3D-Pfad benoetigen, KI aber DXFM_DIM-abhaengig)
;; Modul-eigener Block-Pfad: seit dem Flach-Refactor liegen alle Bloecke direkt
;; unter data/ils/ (die Dimension steckt jetzt im Dateinamen, z.B. AN8_2D.dwg).
;; KI ist DXFM_DIM-abhaengig (*ki-dxfm-dim*); der Dateiname wird an der Einfuege-
;; stelle mit dem Suffix gebildet.
(setq *block-path*
(cond
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
"/data/ils/" *ki-dxfm-dim* "/"))
"/data/ils/"))
((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/data/ils/" *ki-dxfm-dim* "/"))
"/data/ils/"))
(t
(princ (ssg-text "kreisel-warn-blockpfad"))
nil)
@@ -415,11 +417,11 @@
(setq lastEnt nil) ;; Zeichnung ist leer
)
;; AN8 Kreis (Antriebsstation) bei (radius, 0)
(command "_.INSERT" (strcat *block-path* "AN8.dwg") (list radius 0.0 0.0) 1 1 0)
;; AN8 Kreis (Antriebsstation) bei (radius, 0) - Dim-Suffix im Dateinamen
(command "_.INSERT" (strcat *block-path* "AN8_" *ki-dxfm-dim* ".dwg") (list radius 0.0 0.0) 1 1 0)
;; SP8 Kreis (Spannstation) bei (radius+abstand, 0)
(command "_.INSERT" (strcat *block-path* "SP8.dwg") (list (+ radius abstand) 0.0 0.0) 1 1 0)
;; SP8 Kreis (Spannstation) bei (radius+abstand, 0) - Dim-Suffix im Dateinamen
(command "_.INSERT" (strcat *block-path* "SP8_" *ki-dxfm-dim* ".dwg") (list (+ radius abstand) 0.0 0.0) 1 1 0)
;; Tangenten auf Layer S_LP
(ssg-make-layer "S_LP" "7" T)
@@ -1217,9 +1219,9 @@
(setq lastEnt nil)
)
;; AN8 Block einfuegen bei (0,0) - Eckrad ist ein einzelner Kreis
(dbgp (strcat "INSERT Block: " *block-path* "AN8.dwg"))
(command "_.INSERT" (strcat *block-path* "AN8.dwg") (list 0.0 0.0 0.0) 1 1 0)
;; AN8 Block einfuegen bei (0,0) - Eckrad ist ein einzelner Kreis (Dim-Suffix im Dateinamen)
(dbgp (strcat "INSERT Block: " *block-path* "AN8_" *ki-dxfm-dim* ".dwg"))
(command "_.INSERT" (strcat *block-path* "AN8_" *ki-dxfm-dim* ".dwg") (list 0.0 0.0 0.0) 1 1 0)
;; Unsichtbare Attribut-Definitionen erzeugen
(dbgp (strcat "Erzeuge " (itoa (length *eckrad-attrib-defs*)) " Attribut-Definitionen"))
+3 -1
View File
@@ -178,7 +178,9 @@
(setq dim-neu (if (equal (strcase (getenv "DXFM_DIM")) "3D") "2D" "3D"))
(setq basis (getenv "DXFMAKRO"))
(setenv "DXFM_DIM" dim-neu)
(setenv "DXFM_BLOCKS" (strcat basis "\\data\\ils\\" dim-neu))
;; ILS-Bloecke liegen flach unter data\ils (Dimension im Dateinamen) - kein
;; <DIM>-Unterordner mehr. Omniflo behaelt die alte Struktur.
(setenv "DXFM_BLOCKS" (strcat basis "\\data\\ils"))
(setenv "DXFM_OMNIFLO" (strcat basis "\\data\\omniflo\\" dim-neu))
(princ (ssg-textf "dim-switch-modus" (list dim-neu)))
(princ (ssg-textf "dim-switch-blocks" (list (getenv "DXFM_BLOCKS"))))
+91 -50
View File
@@ -329,71 +329,112 @@
"/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
;; Effektiver Blockname zu einem ROH-Namen fuer eine EXPLIZITE Dimension.
;; Seit dem Flach-Refactor tragen Blocknamen das Dimensionssuffix _2D/_3D, damit
;; 2D- und 3D-Variante gleichzeitig in einer Zeichnung existieren koennen
;; (Datei = Blockname + ".dwg", flach unter data/ils/). Ausnahmen ohne Suffix:
;; - Koordinaten-/Subbloecke KS_EIN/KS_AUS/KSYS_*/K1..K4 (exakte Export-Matches),
;; - bereits mit _2D/_3D versehene Namen (kein doppeltes Anhaengen).
(defun ssg-ils-blockname-dim (roh dim / )
(cond
((wcmatch (strcase roh) "KS_EIN,KS_AUS,KSYS_EIN,KSYS_AUS,K1,K2,K3,K4") roh)
((wcmatch (strcase roh) "*_2D,*_3D") roh)
(t (strcat roh "_" dim))))
;; Effektiver Blockname fuer die AKTUELLE Dimension (siehe ssg-ils-dim-aktuell).
(defun ssg-ils-blockname (roh / )
(ssg-ils-blockname-dim roh (ssg-ils-dim-aktuell)))
;; Liefert den vollstaendigen .dwg-Pfad (flache Ablage data/ils/<blockname>.dwg)
;; zu einem ROH-Blocknamen fuer eine EXPLIZITE Dimension. Faellt automatisch auf
;; die 3D-Variante zurueck, wenn die Datei der gewuenschten 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)
(defun ssg-ils-block-datei-dim (blockname dim / basis datei datei3d)
(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"))
(setq datei (strcat basis (ssg-ils-blockname-dim blockname dim) ".dwg"))
(setq datei3d (strcat basis (ssg-ils-blockname-dim blockname "3D") ".dwg"))
(cond
((findfile datei) datei) ; aktuelle Dimension
((findfile datei) datei) ; gewuenschte Dimension
((findfile datei3d) datei3d) ; Fallback: 3D-Variante
(t nil))
)
)
)
;; Merker: welche Dimension ("2D"/"3D") aktuell je Blockname geladen ist.
;; (blockname . dim). Verhindert unnoetiges Neu-Definieren bei gleicher Dim.
(if (not (boundp '*ssg-ils-dim-geladen*)) (setq *ssg-ils-dim-geladen* '()))
;; Wie ssg-ils-block-datei-dim, aber fuer die AKTUELLE Dimension.
(defun ssg-ils-block-datei (blockname / )
(ssg-ils-block-datei-dim blockname (ssg-ils-dim-aktuell)))
;; 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 die Block-DEFINITION zum ROH-Namen 'blockname' in einer
;; EXPLIZITEN Dimension geladen ist. Blocknamen tragen das Suffix _2D/_3D
;; (siehe ssg-ils-blockname-dim), daher koennen 2D und 3D gleichzeitig existieren.
;; WICHTIG: Ein bereits vorhandener gleichnamiger Block wird IMMER neu aus der
;; Datei definiert (Redefine), damit sein Inhalt zur aktuellen Datei passt. Sonst
;; bliebe eine veraltete Definition (z.B. mit falschem 2D/3D-Inhalt aus einer
;; frueheren Sitzung) bestehen und wuerde wiederverwendet.
;; Rueckgabe: effektiver (suffigierter) Blockname oder nil (Datei nicht gefunden).
(defun ssg-ils-block-laden-dim (blockname dim / eff datei base temp-obj osm areq adia)
(setq eff (ssg-ils-blockname-dim blockname dim))
(setq datei (ssg-ils-block-datei-dim blockname dim))
(if (null datei)
nil
(progn
(setq base (vl-filename-base datei))
;; --- TEMP-DIAGNOSE (nach Klaerung wieder entfernen) ---
(princ (strcat "\n[SSG-DBG] roh=" blockname " dim=" dim
" eff=" eff
" existiert-vorher=" (if (tblsearch "BLOCK" eff) "JA" "NEIN")
" datei=" datei))
;; --- ENDE TEMP-DIAGNOSE ---
;; Sichtbar machen, wenn die Datei der gewuenschten Dimension fehlt und der
;; 3D-Fallback greift (dann traegt der Block den gewuenschten Namen, aber
;; den Inhalt der anderen Dimension = potenziell falsche Referenz). Jeder
;; aktiv eingefuegte Block sollte in BEIDEN Dimensionen vorliegen.
(if (not (= (strcase base) (strcase eff)))
(princ (strcat "\n[SSG] WARNUNG: Blockdatei '" eff
".dwg' fehlt - Fallback auf '" base
".dwg' (Inhalt evtl. andere Dimension).")))
(if (and (not (tblsearch "BLOCK" eff)) (= (strcase base) (strcase eff)))
;; Neu UND Dateiname == Blockname -> COM-Weg (kein 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))
;; Sonst (Block existiert bereits ODER Dateiname != Blockname wg.
;; 3D-Fallback) -> aus Datei (neu) definieren. "_Y" beantwortet die
;; Redefine-Abfrage, falls der Block bereits vorhanden ist; danach die
;; laufende Einfuegung sofort abbrechen (Definition ist bereits wirksam).
(progn
(setq areq (getvar "ATTREQ") adia (getvar "ATTDIA") osm (getvar "OSMODE"))
(setvar "ATTREQ" 0)(setvar "ATTDIA" 0)(setvar "OSMODE" 0)
(if (tblsearch "BLOCK" eff)
(command "_.-INSERT" (strcat eff "=" datei) "_Y") ; Redefine bestehender Block
(command "_.-INSERT" (strcat eff "=" datei))) ; neu (kein Redefine-Prompt)
(if (> (getvar "CMDACTIVE") 0) (command))
(if (> (getvar "CMDACTIVE") 0) (command))
(setvar "OSMODE" osm)(setvar "ATTREQ" areq)(setvar "ATTDIA" adia)))
;; --- TEMP-DIAGNOSE: verschachtelte Blocknamen in eff auflisten ---
(if (tblsearch "BLOCK" eff)
(progn
(princ (strcat "\n[SSG-DBG] nested in " eff ":"))
(vl-catch-all-apply
(function (lambda ()
(vlax-for e (vla-Item
(vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
eff)
(if (= (vla-get-ObjectName e) "AcDbBlockReference")
(princ (strcat " [" (vla-get-Name e) "]")))))))))
;; --- ENDE TEMP-DIAGNOSE ---
eff)))
;; Wie ssg-ils-block-laden-dim, aber fuer die AKTUELLE Dimension.
(defun ssg-ils-block-laden (blockname / )
(ssg-ils-block-laden-dim blockname (ssg-ils-dim-aktuell)))
;; ------------------------------------------------------------
;; DIMENSIONS-XDATA (2D/3D) je Block - App "SSG_DIM"
+22 -17
View File
@@ -11,20 +11,20 @@
;; ============================================================
;; TEIL 1: ABHAENGIGKEITEN
;; ============================================================
;; DXFM_DIM lesen; 2D wird auf 3D korrigiert (VF/GF benoetigen Z-Geometrie)
(setq *vf-dxfm-dim* (getenv "DXFM_DIM"))
(if (or (not (= (type *vf-dxfm-dim*) 'STR)) (= *vf-dxfm-dim* "2D"))
(setq *vf-dxfm-dim* "3D"))
;; Block-Pfad: data/ils/3D/ wenn DXFM_DIM nicht gesetzt oder 2D
;; Bloecke liegen seit dem Flach-Refactor direkt unter data/ils/ (die Dimension
;; steckt im Dateinamen bzw. Blocknamen als Suffix _2D/_3D, siehe ssg_core.lsp).
;; VF folgt der aktuellen Dimension (ssg-ils-dim-aktuell) mit 3D-Fallback; das
;; Laden erfolgt zentral ueber ensure-block-loaded/ssg-ils-block-laden.
;; modul-pfad/block-pfad dienen nur noch der Info-Ausgabe (Basisverzeichnis).
(setq modul-pfad
(cond
((and (getenv "DXFMAKRO") (= (type (getenv "DXFMAKRO")) 'STR))
(strcat (vl-string-right-trim "/" (vl-string-translate "\\" "/" (getenv "DXFMAKRO")))
"/data/ils/" *vf-dxfm-dim* "/"))
"/data/ils/"))
((and (boundp '*ssg-lisp-pfad*) (= (type *ssg-lisp-pfad*) 'STR)
(vl-string-search "/Lisp" *ssg-lisp-pfad*))
(strcat (substr *ssg-lisp-pfad* 1 (vl-string-search "/Lisp" *ssg-lisp-pfad*))
"/data/ils/" *vf-dxfm-dim* "/"))
"/data/ils/"))
(t
(princ "\n[vf_core] WARNUNG: Block-Pfad nicht ermittelbar!")
nil)
@@ -259,11 +259,16 @@
;; 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.
;; Zentraler Loader (flache Ablage). Laedt den Block in der AKTUELLEN Dimension
;; (ssg-ils-dim-aktuell: *ssg-ils-dim*-Override -> DXFM_DIM) mit automatischem
;; 3D-Fallback, sodass 2D- und 3D-Aufbau gleichermassen funktionieren. Laedt den
;; Block unter seinem effektiven, dim-suffigierten Namen und GIBT DIESEN ZURUECK,
;; damit Aufrufer ihn zum Einfuegen (vla-InsertBlock/tblsearch) verwenden.
;; Meldung nur bei Fehlschlag.
(if (not (ssg-ils-block-laden blockname))
(princ (ssg-textf "vfc-fehler-block-datei-fehlt" (list blockname)))
)
(ssg-ils-blockname blockname)
)
(defun extract-ks-from-block-raw (block-obj / sub-entities sub-obj ks-results
@@ -450,7 +455,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)))
@@ -522,7 +527,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)))
@@ -610,7 +615,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)))
@@ -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)))
@@ -843,7 +848,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)))
+19 -19
View File
@@ -50,8 +50,8 @@
;; TEIL 2: BIBLIOTHEK INITIALISIEREN (ETAGE-SPEZIFISCH)
;; ============================================================
(defun init-bibliothek-etage ( / temp-obj ks-data ks-ein-pos ks-aus-pos
gefaelle-blockname)
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "AS_Element_30_rechts")))
gefaelle-blockname as30-blk es30-blk)
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" (ssg-ils-blockname "AS_Element_30_rechts"))))
(setq *etage-lib-initialized* nil))
(if *etage-lib-initialized*
(progn (princ (ssg-text "vfe-bib-bereits-init")) t)
@@ -65,13 +65,13 @@
;; AS_30_rechts Masse extrahieren
(princ (ssg-text "vfe-extrahiere-as30"))
(ensure-block-loaded "AS_Element_30_rechts")
(setq as30-blk (ensure-block-loaded "AS_Element_30_rechts"))
(ensure-block-loaded "AS_Element_30_links")
(if (tblsearch "BLOCK" "AS_Element_30_rechts")
(if (tblsearch "BLOCK" as30-blk)
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"AS_Element_30_rechts" 1.0 1.0 1.0 0))
as30-blk 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(vla-Delete temp-obj)
(setq ks-ein-pos nil ks-aus-pos nil)
@@ -99,13 +99,13 @@
;; ES_30_rechts Masse extrahieren
(princ (ssg-text "vfe-extrahiere-es30"))
(ensure-block-loaded "ES_Element_30_rechts")
(setq es30-blk (ensure-block-loaded "ES_Element_30_rechts"))
(ensure-block-loaded "ES_Element_30_links")
(if (tblsearch "BLOCK" "ES_Element_30_rechts")
(if (tblsearch "BLOCK" es30-blk)
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"ES_Element_30_rechts" 1.0 1.0 1.0 0))
es30-blk 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(vla-Delete temp-obj)
(setq ks-ein-pos nil ks-aus-pos nil)
@@ -134,7 +134,7 @@
;; Gefaellebogen_links_30 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_links_30_R500")
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(ensure-block-loaded gefaelle-blockname)
(setq gefaelle-blockname (ensure-block-loaded gefaelle-blockname))
(if (tblsearch "BLOCK" gefaelle-blockname)
(progn
(setq temp-obj (vla-InsertBlock modelspace
@@ -167,7 +167,7 @@
;; Gefaellebogen_rechts_30 Masse extrahieren
(setq gefaelle-blockname "Gefaellebogen_rechts_30_R500")
(princ (ssg-textf "vfe-extrahiere-block-mass" (list gefaelle-blockname)))
(ensure-block-loaded gefaelle-blockname)
(setq gefaelle-blockname (ensure-block-loaded gefaelle-blockname))
(if (tblsearch "BLOCK" gefaelle-blockname)
(progn
(setq temp-obj (vla-InsertBlock modelspace
@@ -220,7 +220,7 @@
(setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
(setq chz (cos rad-hz) shz (sin rad-hz))
(setq cv (cos rad-vert) sv (sin rad-vert))
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
@@ -256,7 +256,7 @@
(setq rad-vert (* (float vert-winkel) (/ pi 180.0)))
(setq chz (cos rad-hz) shz (sin rad-hz))
(setq cv (cos rad-vert) sv (sin rad-vert))
(ensure-block-loaded blockname)
(setq blockname (ensure-block-loaded blockname))
(if (not (tblsearch "BLOCK" blockname))
(progn
(princ (ssg-textf "vfe-block-fehlt-abbruch" (list blockname)))
@@ -290,7 +290,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 "vfe-block-fehlt-abbruch" (list blockname)))
@@ -355,7 +355,7 @@
temp-obj block-obj ks-data ks-ein ks-aus
p-ein p-aus p-ein-s p-aus-s
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 "vfe-block-fehlt-abbruch" (list blockname)))
@@ -630,7 +630,7 @@
"Gefaellebogen_rechts_30_R500"
))
;; Sentinel: Bibliothek neu initialisieren wenn Bloecke fehlen
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" "AS_Element_30_rechts")))
(if (and *etage-lib-initialized* (not (tblsearch "BLOCK" (ssg-ils-blockname "AS_Element_30_rechts"))))
(setq *etage-lib-initialized* nil))
(if (not *etage-lib-initialized*) (init-bibliothek-etage))
@@ -690,11 +690,11 @@
;; 7. 1. Vertikalbogen (3 Grad geneigt)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
)
@@ -727,11 +727,11 @@
;; 9. 2. Vertikalbogen
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
)
+5 -5
View File
@@ -319,7 +319,7 @@
(setq hz (car (frame->hz-winkel frame)))
(setq m (get-bogen-mass bogen-ab 3))
(princ (ssg-text "vfl-bogen-ab3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3" (car frame)
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" (car frame)
0 (car m) (caddr m) hz))
(vfl-frame-3grad pt hz))
frame))
@@ -341,7 +341,7 @@
(progn
(setq m1 (get-bogen-mass bogen-auf 3))
(princ (ssg-text "vfl-bogen-auf3-uebergang"))
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3" pt
(setq pt (insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) (car m1) (caddr m1) hz))))
;; optionaler Separator VOR - in der horizontalen Ebene (0 Grad)
(if sep-vor (setq pt (vfl-sep-hz pt hz)))
@@ -1204,7 +1204,7 @@
;; Aufruf in BricsCAD: VFL_KS_DIAG -> Blockname eingeben.
(defun c:VFL_KS_DIAG ( / bname obj subs s nm inner il ilnm ps pe len)
(setq bname (getstring "\nBlockname fuer KS-Diagnose: "))
(ensure-block-loaded bname)
(setq bname (ensure-block-loaded bname))
(if (not (tblsearch "BLOCK" bname))
(progn (princ (strcat "\nBlock '" bname "' nicht gefunden.")) (exit)))
(setq obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) bname 1.0 1.0 1.0 0))
@@ -1712,13 +1712,13 @@
;; (Rotation 3 Grad). Rueckgabe: neuer Punkt.
(defun vfl3-flach-ein (pt hz / m)
(setq m (get-bogen-mass bogen-auf 3))
(insert-rotated-block-with-ks "Vario_Bogen_auf_3" pt 3 (car m) (caddr m) hz))
(insert-rotated-block-with-ks "Vario_Bogen_auf_3_TEF_rechts" pt 3 (car m) (caddr m) hz))
;; Uebergang aus der flachen Zone (0 Grad) zurueck auf 3-Grad-Basis: EIN ab_3-Bogen
;; (Rotation 0 Grad). Rueckgabe: neuer Punkt.
(defun vfl3-flach-aus (pt hz / m)
(setq m (get-bogen-mass bogen-ab 3))
(insert-rotated-block-with-ks "Vario_Bogen_ab_3" pt 0 (car m) (caddr m) hz))
(insert-rotated-block-with-ks "Vario_Bogen_ab_3_TEF_rechts" pt 0 (car m) (caddr m) hz))
;; Kletter-Segment loesen und Winkel WAEHLEN LASSEN (Modus-1-Solver + vfl-waehle-winkel).
;; Mittige Bruecke -> KEIN terminales AS/ES (Masse auf 0, Save/Restore). feste = fester
+24 -23
View File
@@ -65,15 +65,16 @@
"Staustrecke_SP_1000_mm" "Staustrecke_Separator_SP_300_mm"
"Vario_Umlenkstation_500mm_links" "Vario_Umlenkstation_500mm_rechts"
"Vario_Motorstation_500mm_links" "Vario_Motorstation_500mm_rechts")
(mapcar (function (lambda (w) (strcat "Vario_Bogen_auf_" (itoa w)))) bogen-winkel)
(mapcar (function (lambda (w) (strcat "Vario_Bogen_ab_" (itoa w)))) bogen-winkel)
(mapcar (function (lambda (w) (strcat "Vario_Bogen_auf_" (itoa w) "_TEF_rechts"))) bogen-winkel)
(mapcar (function (lambda (w) (strcat "Vario_Bogen_ab_" (itoa w) "_TEF_rechts"))) bogen-winkel)
)
)
(setq missing '())
(foreach bname required-blocks
(setq datei (strcat block-pfad bname ".dwg"))
(if (not (findfile datei))
(setq missing (cons datei missing))
;; Existenz ueber den zentralen Resolver (flache Ablage + Dim-Suffix der
;; aktuellen Dimension + 3D-Fallback).
(if (not (ssg-ils-block-datei bname))
(setq missing (cons (ssg-ils-blockname bname) missing))
)
)
(if missing
@@ -95,12 +96,12 @@
;; TEIL 3: BIBLIOTHEK INITIALISIEREN
;; ============================================================
(defun init-bibliothek ( / temp-obj bogen-winkel ks-data ks-ein-pos ks-aus-pos
dx dy dz bogen-name)
dx dy dz bogen-name as-blk es-blk)
;; "bereits initialisiert" nur, wenn das Flag gesetzt UND die Bogen-Tabelle
;; tatsaechlich befuellt ist. Sonst (Stuck-State: Flag gesetzt, aber bogen-auf
;; leer - z.B. nach einer fehlgeschlagenen Extraktion) neu initialisieren.
(if (and *lib-initialized* bogen-auf bogen-ab
(tblsearch "BLOCK" "AS_Element_90_links"))
(tblsearch "BLOCK" (ssg-ils-blockname "AS_Element_90_links")))
(progn
(princ (ssg-text "vfs-lib-bereits-init"))
t
@@ -114,13 +115,13 @@
;; AS_90 Masse extrahieren
(princ (ssg-text "vfs-extrahiere-aus"))
(ensure-block-loaded "AS_Element_90_links")
(setq as-blk (ensure-block-loaded "AS_Element_90_links"))
(ensure-block-loaded "AS_Element_90_rechts")
(if (tblsearch "BLOCK" "AS_Element_90_links")
(if (tblsearch "BLOCK" as-blk)
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"AS_Element_90_links" 1.0 1.0 1.0 0))
as-blk 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(vla-Delete temp-obj)
(setq ks-ein-pos nil ks-aus-pos nil)
@@ -143,13 +144,13 @@
;; ES_90 Masse extrahieren
(princ (ssg-text "vfs-extrahiere-ein"))
(ensure-block-loaded "ES_Element_90_links")
(setq es-blk (ensure-block-loaded "ES_Element_90_links"))
(ensure-block-loaded "ES_Element_90_rechts")
(if (tblsearch "BLOCK" "ES_Element_90_links")
(if (tblsearch "BLOCK" es-blk)
(progn
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
"ES_Element_90_links" 1.0 1.0 1.0 0))
es-blk 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(vla-Delete temp-obj)
(setq ks-ein-pos nil ks-aus-pos nil)
@@ -178,8 +179,8 @@
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(foreach w bogen-winkel
;; Aufwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w)))
(ensure-block-loaded bogen-name)
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) "_TEF_rechts"))
(setq bogen-name (ensure-block-loaded bogen-name))
(if (tblsearch "BLOCK" bogen-name)
(progn
(setq temp-obj (vla-InsertBlock modelspace
@@ -205,8 +206,8 @@
(princ (ssg-textf "vfs-bogen-auf-block-fehlt" (list (itoa w))))
)
;; Abwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w)))
(ensure-block-loaded bogen-name)
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) "_TEF_rechts"))
(setq bogen-name (ensure-block-loaded bogen-name))
(if (tblsearch "BLOCK" bogen-name)
(progn
(setq temp-obj (vla-InsertBlock modelspace
@@ -521,16 +522,16 @@
;; horizontalen Mitte vermitteln muessen.
(if (= best-winkel 0)
(progn
(setq bogen-name "Vario_Bogen_auf_3")
(setq bogen-name "Vario_Bogen_auf_3_TEF_rechts")
(setq bogen-mass (get-bogen-mass bogen-auf 3))
)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
)
@@ -576,16 +577,16 @@
;; 7. 2. Vertikalbogen
(if (= best-winkel 0)
(progn
(setq bogen-name "Vario_Bogen_ab_3")
(setq bogen-name "Vario_Bogen_ab_3_TEF_rechts")
(setq bogen-mass (get-bogen-mass bogen-ab 3))
)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel)))
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
)