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

Merge remote-tracking branch 'origin/master'

Browse Source 
# Conflicts:
#	Lisp/Gefaellestrecke.lsp
#	Lisp/ssg_core.lsp
#	Lisp/vf_core.lsp
This commit is contained in:
Yuelin Wang
2026-07-24 13:38:01 +02:00
parent d21f0acb4e b16c2e0fa1
commit cdc33230e3
160 changed files with 213 additions and 159 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/Gefaellestrecke.lsp
+28 -23
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)
)
)
@@ -115,14 +115,19 @@
;; --- Block als einzelne DWG-Datei aus block-pfad laden ---
(if (null (car (atoms-family 1 '("ENSURE-BLOCK-LOADED"))))
(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
(defun ensure-block-loaded (blockname / )
;; 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)
)
)
@@ -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)))
Lisp/KreiselInsert.lsp
+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"))
Lisp/SSG_LIB_Commands.lsp
+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"))))
Lisp/ssg_core.lsp
+100 -61
View File
@@ -329,79 +329,118 @@
"/data/ils/"))
(t nil)))
;; 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)
;; 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-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 (ssg-ils-blockname-dim blockname dim) ".dwg"))
(setq datei3d (strcat basis (ssg-ils-blockname-dim blockname "3D") ".dwg"))
(cond
((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)))))
((findfile datei) datei) ; gewuenschte Dimension
((findfile datei3d) datei3d) ; Fallback: 3D-Variante
(t nil))
)
)
)
;; 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))
;; 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)))
;; Merker: welche Dimension je (ALT-Schema) Blockname geladen ist.
(if (not (boundp '*ssg-ils-dim-geladen*)) (setq *ssg-ils-dim-geladen* '()))
;; 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)
;; 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 datei (car dn) realname (cdr dn))
(if (/= realname base)
;; ---- NEU-Schema (eindeutiger Name) ----
(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
(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) ----
(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 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)))))
(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)))
;; Ermittelt die "eigene" Ebene eines geladenen Blocks: haeufigste Ebene (ausser
;; "0") seiner Definition-Entities; nil, wenn nur "0".
;; 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)))
;; ------------------------------------------------------------
;; AUTO-LAYER: INSERT-Referenz auf die eigene Ebene ihres Blocks setzen
;; ------------------------------------------------------------
;; 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
Lisp/vf_core.lsp
+17 -14
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)
@@ -258,14 +258,17 @@
;; ============================================================
;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION
;; ============================================================
(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
(defun ensure-block-loaded (blockname / )
;; 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
Lisp/vf_etage.lsp
+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))
)
)
Lisp/vf_linienzug.lsp
+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
Lisp/vf_standard.lsp
+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))
)
)