Merge remote-tracking branch 'origin/master'

# Conflicts:
#	Lisp/Gefaellestrecke.lsp
#	Lisp/ssg_core.lsp
#	Lisp/vf_core.lsp
This commit is contained in:
2026-07-24 13:38:01 +02:00
160 changed files with 213 additions and 159 deletions
+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