821b81135d
Drei zusammenhaengende Korrekturen am GF-Zweig mit ES-Element (Modus 1). 1) ES-Fussabdruck wurde massiv unterschaetzt (333.65 mm zu lang) Reserviert wurde (abs ein-dx) - die Block-X-Komponente aus vf-element-masse. Ein Element wird aber so gedreht eingebaut, dass sein KS_EIN auf der Fahrtrichtung liegt; beim drehenden ES_Element_30 (ein-ang=120 Grad) landet dadurch ein Teil der Block-Y-Komponente auf der Fahrtachse. Real verbraucht es laengs 576.2 mm statt der reservierten 242.6 mm - die Kette ragte um die Differenz ueber den gepickten Endpunkt hinaus (Nutzer-Befund 2026-10-09). Warum das lange unentdeckt blieb: beim ES_Element_90 ist ein-ang=0, dort ist (abs ein-dx) ZUFAELLIG richtig. Der frueher bestaetigende 90-Grad-Test konnte den Fehler strukturell nicht finden (Nutzer-Hinweis). Neu in vf_core.lsp: vf-element-laengs / vf-element-quer (hz-unabhaengige Projektion auf bzw. quer zur Fahrtrichtung), vf-set-es-masse setzt zusaetzlich ein-laengs / ein-quer. In vf_linienzug.lsp liest vfl-es-laengs den Wert mit Rueckfallkette; ein bewusst genulltes ein-dx gewinnt dabei, damit die rund zwei Dutzend Null-/Restore-Stellen keinen Doppelabzug bekommen. In BricsCAD bestaetigt: Separator+ES verbrauchen 875.83 mm gegen 875.79 mm Soll (0.04 mm), Hoehe 151.23 gegen 151.20 mm. 2) Endpunkt per Ziellinie statt per Klick Steht die Fahrtrichtung durch den Vorgaenger fest, ist die Laenge nicht mehr frei: die (um den ES-Querversatz seitlich versetzte) Bahn des ES-KS_AUS trifft eine Ziellinie in genau einem Punkt. Ein Klick kann den nur annaehern. Neue Frage mit zwei gleichwertigen Optionen (Radio-Buttons im Wizard-Modus): Ziellinie durch ZWEI PUNKTE zeichnen - Schnittpunkt wird gerechnet - oder wie bisher einen Punkt waehlen. REIN PLANAR: die Hoehe kommt weiterhin aus dem Gefaellewinkel, die Ziellinie bestimmt nur X/Y (Nutzer-Praezisierung). Beide Wege schreiben denselben einzelnen "DL"-Journaleintrag - Replay, Doppelklick-Edit und 2D/3D-Konvertierung muessen von Ziellinien nichts wissen. Die Bindung an die Linie besteht nur beim Bauen: wird die Linie spaeter verschoben, folgt die Kette NICHT. Abwaertskompatibilitaet: die neue Frage erzeugt einen zusaetzlichen Journaleintrag, den aeltere Ketten nicht haben. vfl-replay-peek-art sieht beim Replay nach, was tatsaechlich ansteht; steht dort ein "DL", ist es ein Altbestand und die Frage entfaellt - sonst haette sie den Laengenwert als Antwort verschluckt (Queue-Desync). 3) Bedienung: Achsenzwang und ruhige Ansicht vfl-getpoint-achse zwingt den Cursor beim Picken auf die Anschlussachse (SNAPANG + ORTHOMODE, kein BKS-Wechsel - getpoint liefert daher unveraenderte Koordinaten). Nur die horizontale Richtung wird erzwungen, die Hoehe bleibt frei. vfl-view-refresh zoomte vor JEDER Laengeneingabe hart auf _Extents - die Ansicht sprang bei grossen Anlagen nach jedem Klick weg. Jetzt wird nur noch eingegriffen, wenn der Baupunkt aus dem sichtbaren Ausschnitt laeuft, und dann per _ZOOM _Center unter Beibehaltung der Zoomstufe. 13 neue Unit-Tests (etage-laengs/-quer, vfl-es-laengs, vfl-kreuz2, vfl-laenge-bis-ziellinie inkl. Realfall aus dem BricsCAD-Log), Suite 533/533 gruen. lang-Paritaet geprueft. Offen und bewusst nicht angefasst: vfl-winkel-machbar-p nutzt aus-dx/ein-dx ebenfalls als Laengsmass und hat damit denselben Fehler (AS_30: 276 mm, ES_30: 334 mm). Der saubere Fix fuellt ein-dx/aus-dx an der Quelle mit dem Laengswert - das beruehrt rund 87 Fundstellen samt ihrer Null-/Restore- Konvention und gehoert separat getestet. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
1537 lines
71 KiB
Common Lisp
1537 lines
71 KiB
Common Lisp
;; ============================================================
|
||
;; VF_CORE - VarioFoerderer Kern-Modul
|
||
;; Version: 26.0
|
||
;; Architektur: Plugin/Dispatcher
|
||
;; Laedt automatisch: vf_standard.lsp, vf_etage.lsp, vf_linienzug.lsp
|
||
;; Befehle: VarioFoerderer (Alias: FOERDERANLAGE, ETAGEVARIOFOERDERER)
|
||
;; ============================================================
|
||
|
||
(vl-load-com)
|
||
|
||
;; ============================================================
|
||
;; TEIL 1: ABHAENGIGKEITEN
|
||
;; ============================================================
|
||
;; 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/"))
|
||
((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/"))
|
||
(t
|
||
(princ "\n[vf_core] WARNUNG: Block-Pfad nicht ermittelbar!")
|
||
nil)
|
||
)
|
||
)
|
||
(setq block-pfad modul-pfad)
|
||
|
||
;; ssg_core laden falls noch nicht geschehen: 1) DXFM_LISP, 2) *ssg-lisp-pfad*
|
||
(if (not *ssg-core-loaded*)
|
||
(progn
|
||
(setq *vf-core-lisp-pfad*
|
||
(cond
|
||
((getenv "DXFM_LISP")
|
||
(vl-string-translate "\\" "/" (getenv "DXFM_LISP")))
|
||
((and (boundp '*ssg-lisp-pfad*) *ssg-lisp-pfad*)
|
||
*ssg-lisp-pfad*)
|
||
(t nil)
|
||
)
|
||
)
|
||
(if *vf-core-lisp-pfad*
|
||
(progn
|
||
(load (strcat *vf-core-lisp-pfad* "/ssg_core.lsp"))
|
||
(ssg-load-config)
|
||
(setq *ssg-core-loaded* t)
|
||
)
|
||
(princ "\n[vf_core] WARNUNG: DXFM_LISP nicht gesetzt - ssg_core konnte nicht geladen werden!")
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Gemeinsame KS-Extraktion + Einfuegeprimitiven (ssg_ks_insert.lsp) sicherstellen.
|
||
;; Im MNL-Fluss bereits vorgeladen; dieser Guard deckt das isolierte Laden von
|
||
;; vf_core (Test/Dev) ab. ssg-lisp-datei-pfad stammt aus dem oben geladenen ssg_core.
|
||
(if (and (not (car (atoms-family 1 '("INSERT-BLOCK-BY-KS"))))
|
||
(car (atoms-family 1 '("SSG-LISP-DATEI-PFAD"))))
|
||
(progn
|
||
(setq *vf-ksins-pfad* (ssg-lisp-datei-pfad "ssg_ks_insert.lsp"))
|
||
(if (and *vf-ksins-pfad* (findfile *vf-ksins-pfad*))
|
||
(load *vf-ksins-pfad*)
|
||
(princ "\n[vf_core] WARNUNG: ssg_ks_insert.lsp nicht gefunden!"))
|
||
)
|
||
)
|
||
|
||
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
|
||
(setq modelspace (vla-get-ModelSpace doc))
|
||
|
||
;; ============================================================
|
||
;; TEIL 2: TYP-REGISTRY
|
||
;; ============================================================
|
||
(if (null *vf-typ-registry*) (setq *vf-typ-registry* nil))
|
||
(if (null *vf-vorauswahl-typ*) (setq *vf-vorauswahl-typ* nil))
|
||
;; Vorauswahl des Eingabemodus (Standard/Etage): "1"=3D-Linie, "2"=Werte.
|
||
;; Von den Menue-Wrappern gesetzt, damit die Konsolen-/Dialog-Frage
|
||
;; entfaellt. nil = interaktiv fragen (Direktaufruf VarioFoerderer).
|
||
(if (null *vf-vorauswahl-eingabemodus*) (setq *vf-vorauswahl-eingabemodus* nil))
|
||
;; Vorauswahl des Linienzug-Modus (1-5): von jedem der fuenf Linienzug-
|
||
;; Menue-Wrapper (c:LinienzugVarioFoerdererManuell/-Zielhoehe/-Stueckweise,
|
||
;; c:QcLinieMitGf/-UForm) gesetzt - der frueher hier noetige Modus-Dialog/
|
||
;; Konsolen-Fallback ist dadurch komplett entfallen (siehe c:VarioFoerderer).
|
||
(if (null *vf-vorauswahl-linienzug-modus*) (setq *vf-vorauswahl-linienzug-modus* nil))
|
||
|
||
;; Registriert einen Foerderanlagen-Typ.
|
||
;; berechne-fn: '(lambda (deltaL deltaH richtung seite) ...)
|
||
;; Ruft init-Bibliothek und Winkelberechnung auf.
|
||
;; Gibt zurueck: (list best-winkel best-L_GF best-L_VF ergebnis-liste)
|
||
;; einfuege-fn: '(lambda (deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite) ...)
|
||
;; Fuegt alle Bloecke ein. Gibt endpunkt zurueck.
|
||
(defun vf-typ-registrieren (typ-name berechne-fn einfuege-fn beschreibung)
|
||
(if (assoc typ-name *vf-typ-registry*)
|
||
(princ (strcat "\n Typ '" typ-name "' bereits registriert."))
|
||
(setq *vf-typ-registry*
|
||
(append *vf-typ-registry*
|
||
(list (list typ-name berechne-fn einfuege-fn beschreibung))))
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 3: GLOBALE VARIABLEN
|
||
;; ============================================================
|
||
(if (null #VF_LetzteNr) (setq #VF_LetzteNr 0))
|
||
(setq *library-loaded* nil)
|
||
(setq *ks-cache* nil)
|
||
(setq grad-zeichen (chr 176))
|
||
|
||
;; Attribut-Definitionen fuer VF_*-Bloecke kommen aus dem gemeinsamen
|
||
;; Strecken-Schema in ssg_core.lsp (ssg-strecke-attrib-defs). VarioFoerderer
|
||
;; ist immer TYP "Streckengruppe" -> voller Attributsatz.
|
||
|
||
;; ============================================================
|
||
;; TEIL 4: HILFSFUNKTIONEN
|
||
;; ============================================================
|
||
;; vec-length, ks-line-axis, ks-normalize-name, ks-relativize, ks-absolutize
|
||
;; liegen jetzt zentral in ssg_ks_insert.lsp (gemeinsam mit Gefaellestrecke,
|
||
;; siehe dort). Hier nur noch die vf_core-spezifischen Helfer.
|
||
(defun fmt (x)
|
||
(if (and (numberp x) (not (equal x nil))) (rtos x 2 2) "---"))
|
||
|
||
(defun punkt-differenz (p1 p2)
|
||
(list (- (car p2) (car p1)) (- (cadr p2) (cadr p1)) (- (caddr p2) (caddr p1))))
|
||
|
||
;; ============================================================
|
||
;; TEIL 4b: KS-FRAME MATHEMATIK
|
||
;; ============================================================
|
||
;; vec3-cross/vec3-normalize/mat3-mul-vec3/mat3-from-frames (und die
|
||
;; OCS-/Extrusions-Helfer mat3-mul-mat3/mat3-ocs-basis/mat3-ocs-matrix/
|
||
;; mat3-rz/mat3-from-normal-rotation) sitzen in ssg_core.lsp, nicht hier:
|
||
;; ssg-collect-nested-inserts-rel (Export-Zuordnung verpackter Separatoren)
|
||
;; braucht sie ebenfalls und ist ein CORE-Modul, das IMMER vor vf_core.lsp
|
||
;; geladen ist - vf_core.lsp selbst ist nur ein Feature-Modul (nicht jede
|
||
;; Zeichnung laedt VarioFoerderer). Damit beide Seiten dieselbe, einzige
|
||
;; Definition nutzen, wohnen die allgemeinen Vektor-/Matrix-Helfer im immer
|
||
;; geladenen Core (wie ssg-rot-matrix-zy schon dort wohnt) statt hier.
|
||
|
||
;; Normierter KS-Rahmen aus rohen KS-Daten (origin x-end y-end z-end)
|
||
;; Eingabe: Teilliste aus extract-ks-from-block-raw, z.B. (cadr (assoc "KS_EIN" ks-data))
|
||
;; Rueckgabe: (P xu yu zu) - Ursprung + 3 normierte Einheitsvektoren
|
||
(defun ks-frame-extract (ks-raw / origin x-end y-end z-end)
|
||
(setq origin (car ks-raw)
|
||
x-end (cadr ks-raw)
|
||
y-end (caddr ks-raw)
|
||
z-end (cadddr ks-raw))
|
||
(list origin
|
||
(vec3-normalize (list (- (car x-end)(car origin))
|
||
(- (cadr x-end)(cadr origin))
|
||
(- (caddr x-end)(caddr origin))))
|
||
(vec3-normalize (list (- (car y-end)(car origin))
|
||
(- (cadr y-end)(cadr origin))
|
||
(- (caddr y-end)(caddr origin))))
|
||
(vec3-normalize (list (- (car z-end)(car origin))
|
||
(- (cadr z-end)(cadr origin))
|
||
(- (caddr z-end)(caddr origin))))))
|
||
|
||
;; KS-Rahmen aus normiertem Fahrtrichtungsvektor mit horizontaler Senkrechtachse
|
||
;; Rueckgabe: (P xu yu zu)
|
||
;; Konvention: yu = horizontal senkrecht zu xu (links der Fahrtrichtung)
|
||
;; zu = xu x yu (senkrecht zur Gurtoberflaeche, nach oben)
|
||
(defun make-frame-from-dir (P xu-unit / hlen yu zu)
|
||
(setq hlen (sqrt (+ (* (car xu-unit)(car xu-unit))
|
||
(* (cadr xu-unit)(cadr xu-unit)))))
|
||
(setq yu
|
||
(if (> hlen 1e-6)
|
||
(list (/ (- (cadr xu-unit)) hlen)
|
||
(/ (car xu-unit) hlen)
|
||
0.0)
|
||
'(1.0 0.0 0.0)))
|
||
(setq zu (vec3-cross xu-unit yu))
|
||
(list P xu-unit yu zu))
|
||
|
||
;; --- Bruecke Frame <-> (hz, winkel) ---
|
||
;; Fuer vf-linienzug (gemischte GF/VF-Ketten, vf_linienzug.lsp): Gefaellestrecke
|
||
;; traegt den Kettenzustand als Frame (Position + Richtungsvektor xu) weiter,
|
||
;; waehrend die aelteren VF-Einfuegefunktionen (insert-block-by-ks,
|
||
;; insert-rotated-block-with-ks, insert-inclined-scaled-block) Position+hz+winkel
|
||
;; getrennt erwarten. Beide nutzen dieselbe Rz(hz)*Ry(winkel)-Rotation
|
||
;; (winkel positiv = abwaerts, xu = (cos(hz)cos(v), sin(hz)cos(v), -sin(v))),
|
||
;; daher sind Frame und (hz winkel) verlustfrei ineinander umrechenbar.
|
||
(defun frame->hz-winkel (frame / xu horiz-len)
|
||
(setq xu (cadr frame))
|
||
(setq horiz-len (sqrt (+ (* (car xu)(car xu)) (* (cadr xu)(cadr xu)))))
|
||
(list
|
||
(* (atan (cadr xu) (car xu)) (/ 180.0 pi))
|
||
(* (atan (- (caddr xu)) horiz-len) (/ 180.0 pi))
|
||
)
|
||
)
|
||
|
||
(defun hz-winkel->xu (hz winkel / rad-h rad-v)
|
||
(setq rad-h (* (float hz) (/ pi 180.0)))
|
||
(setq rad-v (* (float winkel) (/ pi 180.0)))
|
||
(list (* (cos rad-h)(cos rad-v))
|
||
(* (sin rad-h)(cos rad-v))
|
||
(- (sin rad-v)))
|
||
)
|
||
|
||
;; Hinweis: Die Rz(hz)*Ry(vert)-Rotationsmatrix (vf-rot-matrix) liegt zentral
|
||
;; in ssg_core.lsp (ssg-rot-matrix-zy), da sie dependency-frei ist und auch von
|
||
;; Gefaellestrecke/TEF genutzt wird. Duenner Alias fuer die VF-Aufrufstellen:
|
||
(defun vf-rot-matrix (chz shz cv sv) (ssg-rot-matrix-zy chz shz cv sv))
|
||
|
||
(defun punkt-hz-winkel->frame (punkt hz winkel)
|
||
(make-frame-from-dir punkt (hz-winkel->xu hz winkel))
|
||
)
|
||
|
||
;; ------------------------------------------------------------
|
||
;; MOTORSEITE (Motor-/Umlenkstation links|rechts)
|
||
;; ------------------------------------------------------------
|
||
;; Wird vom Bau-Ablauf (Dialog/Edit) vor dem Einfuegen gesetzt und von
|
||
;; vfs-vf-entry/vfs-vf-exit (bzw. Etage) beim Blocknamen gelesen. Analog zum
|
||
;; Dimensions-Override *ssg-ils-dim*, damit die Seite nicht durch saemtliche
|
||
;; Funktionssignaturen gefaedelt werden muss. Default "rechts".
|
||
(if (not (boundp '*vf-motorseite*)) (setq *vf-motorseite* nil))
|
||
(defun vf-motorseite-aktuell ( / )
|
||
(if (member *vf-motorseite* '("links" "rechts")) *vf-motorseite* "rechts"))
|
||
|
||
;; ============================================================
|
||
;; TEIL 5: KS_EIN/KS_AUS EXTRAKTION
|
||
;; ============================================================
|
||
;; ensure-block-loaded, extract-ks-from-block-raw und extract-ks-from-block
|
||
;; liegen jetzt zentral in ssg_ks_insert.lsp (gemeinsam mit den Einfuege-
|
||
;; primitiven und Gefaellestrecke). Wird ueber die MNL vor vf_core geladen.
|
||
|
||
;; ============================================================
|
||
;; TEIL 6: PUNKTE-AUSWAHL
|
||
;; ============================================================
|
||
(defun get-3d-point-from-object (msg / ent obj pt variant)
|
||
(princ msg)
|
||
(princ (ssg-text "vfc-objekt-block-waehlen"))
|
||
(setq ent (entsel))
|
||
(if ent
|
||
(progn
|
||
(setq obj (vlax-ename->vla-object (car ent)))
|
||
(if (vlax-property-available-p obj 'InsertionPoint)
|
||
(progn
|
||
(setq variant (vla-get-InsertionPoint obj))
|
||
(setq pt (vlax-safearray->list (vlax-variant-value variant)))
|
||
(princ (ssg-textf "vfc-block-einfuegepunkt"
|
||
(list (rtos (car pt) 2 3) (rtos (cadr pt) 2 3) (rtos (caddr pt) 2 3))))
|
||
)
|
||
(progn
|
||
(setq pt (cadr ent))
|
||
(princ (ssg-textf "vfc-punkt-auf-objekt" (list (rtos (caddr pt) 2 2))))
|
||
)
|
||
)
|
||
)
|
||
(progn
|
||
(princ (ssg-text "vfc-kein-objekt-gewaehlt"))
|
||
(setq pt nil)
|
||
)
|
||
)
|
||
pt
|
||
)
|
||
|
||
(defun get-line-start-end-points (msg / ent obj obj-name start-pt end-pt)
|
||
(princ msg)
|
||
(princ (ssg-text "vfc-linie-polylinie-waehlen"))
|
||
(setq ent (entsel))
|
||
(if ent
|
||
(progn
|
||
(setq obj (vlax-ename->vla-object (car ent)))
|
||
(setq obj-name (vla-get-ObjectName obj))
|
||
(cond
|
||
((= obj-name "AcDbLine")
|
||
(setq start-pt (vlax-safearray->list
|
||
(vlax-variant-value (vla-get-StartPoint obj))))
|
||
(setq end-pt (vlax-safearray->list
|
||
(vlax-variant-value (vla-get-EndPoint obj))))
|
||
(princ (ssg-textf "vfc-3dlinie-start-ende"
|
||
(list (rtos (car start-pt) 2 2) (rtos (cadr start-pt) 2 2) (rtos (caddr start-pt) 2 2)
|
||
(rtos (car end-pt) 2 2) (rtos (cadr end-pt) 2 2) (rtos (caddr end-pt) 2 2))))
|
||
)
|
||
((= obj-name "AcDbPolyline")
|
||
(setq start-pt (vlax-curve-getStartPoint obj))
|
||
(setq end-pt (vlax-curve-getEndPoint obj))
|
||
(princ (ssg-textf "vfc-3dpolylinie-start-ende"
|
||
(list (rtos (caddr start-pt) 2 2) (rtos (caddr end-pt) 2 2))))
|
||
)
|
||
(t
|
||
(princ (ssg-text "vfc-fehler-keine-linie"))
|
||
(setq start-pt nil end-pt nil)
|
||
)
|
||
)
|
||
)
|
||
(progn
|
||
(princ (ssg-text "vfc-kein-objekt-gewaehlt"))
|
||
(setq start-pt nil end-pt nil)
|
||
)
|
||
)
|
||
(if (and start-pt end-pt) (list start-pt end-pt) nil)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 7: VF-NUMMERIERUNG
|
||
;; ============================================================
|
||
;; Naechste freie VF-Nummer aus den Blocknamen VF_<n> ableiten (der Blockname
|
||
;; ist die Bezeichnung/Zaehlung; ein separates NUMMER-Attribut gibt es nicht mehr).
|
||
(defun vf-next-number ( / ss i nr maxnr bname)
|
||
(setq maxnr 0)
|
||
(setq ss (ssget "X" '((0 . "INSERT") (2 . "VF_*"))))
|
||
(if ss
|
||
(progn
|
||
(setq i 0)
|
||
(while (< i (sslength ss))
|
||
(setq bname (cdr (assoc 2 (entget (ssname ss i)))))
|
||
(setq nr (atoi (substr bname 4))) ; "VF_" = 3 Zeichen -> ab Position 4
|
||
(if (> nr maxnr) (setq maxnr nr))
|
||
(setq i (1+ i))
|
||
)
|
||
)
|
||
)
|
||
(setq #VF_LetzteNr (max #VF_LetzteNr maxnr))
|
||
(setq #VF_LetzteNr (1+ #VF_LetzteNr))
|
||
;; Nummern ueberspringen, deren Block-DEFINITION bereits existiert (z.B. Rest
|
||
;; eines frueher fehlgeschlagenen Baus, der eine VF_n-Definition ohne INSERT
|
||
;; hinterliess). Sonst trifft das spaetere _.-BLOCK auf einen vorhandenen
|
||
;; Namen -> "Neu definieren?"-Abfrage verschluckt die Folge-Eingaben ->
|
||
;; Block wird nicht korrekt erzeugt ("Eintrag kann nicht erkannt werden").
|
||
(while (tblsearch "BLOCK" (strcat "VF_" (itoa #VF_LetzteNr)))
|
||
(princ (strcat "\n [VF-Nr] VF_" (itoa #VF_LetzteNr) " existiert bereits, naechste..."))
|
||
(setq #VF_LetzteNr (1+ #VF_LetzteNr)))
|
||
#VF_LetzteNr
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen)
|
||
;; ============================================================
|
||
;; insert-block-by-ks (nur Rz), insert-inclined-scaled-block und
|
||
;; insert-rotated-block-with-ks (beide Rz*Ry) liegen jetzt zentral in
|
||
;; ssg_ks_insert.lsp (gemeinsam mit Gefaellestrecke). Die folgenden
|
||
;; Frame-basierten Einfuegefunktionen bleiben vf_core-spezifisch.
|
||
|
||
;; Fuegt Block ein und richtet KS_EIN am Ziel-Rahmen aus (volle 3D-Rotation).
|
||
;; target-frame : (P xt yt zt) - Ziel-Rahmen, z.B. KS_AUS des Vorgaenger-Elements
|
||
;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks
|
||
(defun insert-block-ks-to-ks (blockname target-frame /
|
||
block-obj temp-obj ks-data ks-ein-raw ks-aus-raw
|
||
f-ein f-aus P-t xt yt zt
|
||
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)
|
||
(setq blockname (ensure-block-loaded blockname))
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
(progn
|
||
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
|
||
(exit)))
|
||
;; Ziel-Rahmen auspacken
|
||
(setq P-t (car target-frame)
|
||
xt (cadr target-frame)
|
||
yt (caddr target-frame)
|
||
zt (cadddr target-frame))
|
||
;; KS_EIN/KS_AUS ueber EIGENES Temp-Objekt ermitteln (nicht am spaeter
|
||
;; tatsaechlich platzierten block-obj - extract-ks-from-block exploded
|
||
;; das uebergebene Objekt intern; das darf nicht das Objekt sein, das
|
||
;; anschliessend transformiert in der Zeichnung bleibt).
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
blockname 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||
(setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data)))
|
||
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
|
||
(if (not (and ks-ein-raw ks-aus-raw))
|
||
(progn
|
||
(princ (ssg-textf "vfc-fehler-ks-fehlen" (list blockname)))
|
||
(exit)))
|
||
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
|
||
;; bleibt tatsaechlich in der Zeichnung.
|
||
(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))
|
||
(setq P-ein (car f-ein)
|
||
xe (cadr f-ein)
|
||
ye (caddr f-ein)
|
||
ze (cadddr f-ein))
|
||
(setq P-aus (car f-aus)
|
||
xu-aus (cadr f-aus)
|
||
yu-aus (caddr f-aus)
|
||
zu-aus (cadddr f-aus))
|
||
;; Rotationsmatrix: R * xe = xt, R * ye = yt, R * ze = zt
|
||
(setq R (mat3-from-frames xt yt zt xe ye ze))
|
||
;; Translation: t = P_target - R * P_ein
|
||
(setq R-Pein (mat3-mul-vec3 R P-ein))
|
||
(setq tx (- (car P-t) (car R-Pein))
|
||
ty (- (cadr P-t) (cadr R-Pein))
|
||
tz (- (caddr P-t) (caddr R-Pein)))
|
||
;; 4x4-Transformationsmatrix aufbauen und auf Block anwenden
|
||
(setq T4 (vlax-tmatrix
|
||
(list (list (car (car R)) (cadr (car R)) (caddr (car R)) tx)
|
||
(list (car (cadr R)) (cadr (cadr R)) (caddr (cadr R)) ty)
|
||
(list (car (caddr R)) (cadr (caddr R)) (caddr (caddr R)) tz)
|
||
(list 0.0 0.0 0.0 1.0))))
|
||
(vla-TransformBy block-obj T4)
|
||
;; Ausgabe-Rahmen fuer KS_AUS mathematisch berechnen (kein Re-Extrahieren noetig)
|
||
(setq R-Paus (mat3-mul-vec3 R P-aus))
|
||
(setq P-out (list (+ (car R-Paus) tx)
|
||
(+ (cadr R-Paus) ty)
|
||
(+ (caddr R-Paus) tz)))
|
||
(setq xu-out (mat3-mul-vec3 R xu-aus)
|
||
yu-out (mat3-mul-vec3 R yu-aus)
|
||
zu-out (mat3-mul-vec3 R zu-aus))
|
||
;; Diagnose (Schalter "vf-sepliste", siehe ssg_ks_insert.lsp): setzt im
|
||
;; Linienzug die AS-/ES-Elemente, also den ERSTEN und LETZTEN Sepliste-Eintrag.
|
||
;; Die Translation (tx ty tz) ist hier der Gruppencode 10 des Blocks.
|
||
(if (car (atoms-family 1 '("SSG-SEPLISTE-DBG")))
|
||
(ssg-sepliste-dbg
|
||
(strcat "insert-block-ks-to-ks " blockname
|
||
" ziel-P=" (ssg-sepliste-dbg-pt P-t)
|
||
" ks_ein_lokal=" (ssg-sepliste-dbg-pt P-ein)
|
||
" translation(=Gruppencode 10)=" (ssg-sepliste-dbg-pt (list tx ty tz))
|
||
" ks_aus_welt=" (ssg-sepliste-dbg-pt P-out))))
|
||
(princ (ssg-textf "vfc-block-eingefuegt-ksaus"
|
||
(list blockname (rtos (car P-out) 2 2) (rtos (cadr P-out) 2 2) (rtos (caddr P-out) 2 2))))
|
||
(list P-out xu-out yu-out zu-out))
|
||
|
||
;; Fuegt Block ein: Orientierung wie insert-block-ks-to-ks (KS_EIN-Achsen werden
|
||
;; am Ziel-Rahmen ausgerichtet). Die POSITION wird jedoch fuer XY und Z aus
|
||
;; ZWEI VERSCHIEDENEN lokalen Referenzpunkten abgeleitet:
|
||
;; xy-ref : welcher lokale Punkt in X/Y exakt auf target-frame's P treffen soll
|
||
;; z-ref : welcher lokale Punkt in Z exakt auf z-ziel treffen soll
|
||
;; Werte fuer xy-ref/z-ref: "KS_EIN", "KS_AUS" oder nil (=Block-Ursprung 0,0,0).
|
||
;; Hintergrund: Bei seitlich angebundenen Elementen (z.B. AS_Element/ES_Element)
|
||
;; liegt KS_EIN bzw. KS_AUS seitlich versetzt vom Block-Ursprung (Drehteller-
|
||
;; Anschluss). Die Mittelachse der Foerderstrecke soll durch den Block-Ursprung
|
||
;; laufen (xy-ref), waehrend die Anschlusshoehe weiterhin exakt am jeweiligen
|
||
;; KS-Punkt (z-ref) gemessen werden muss (konsistent mit Modus 1+2 und der
|
||
;; Gefaellewinkel-Korrektur in gf-messe-dz-block).
|
||
;; target-frame : (P xt yt zt) - Ziel-Rahmen (Punkt auf der Mittelachse + Fahrtrichtung)
|
||
;; z-ziel : gewuenschte Welt-Z-Koordinate des z-ref-Punktes
|
||
;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks
|
||
(defun insert-block-mixed-to-ks (blockname target-frame z-ziel xy-ref z-ref /
|
||
block-obj temp-obj ks-data ks-ein-raw ks-aus-raw
|
||
f-ein f-aus P-t xt yt zt
|
||
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)
|
||
(setq blockname (ensure-block-loaded blockname))
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
(progn
|
||
(princ (ssg-textf "vfc-fehler-block-nicht-in-bibliothek" (list blockname)))
|
||
(exit)))
|
||
;; Ziel-Rahmen auspacken
|
||
(setq P-t (car target-frame)
|
||
xt (cadr target-frame)
|
||
yt (caddr target-frame)
|
||
zt (cadddr target-frame))
|
||
;; KS_EIN/KS_AUS ueber EIGENES Temp-Objekt ermitteln (nicht am spaeter
|
||
;; tatsaechlich platzierten block-obj - extract-ks-from-block exploded
|
||
;; das uebergebene Objekt intern; das darf nicht das Objekt sein, das
|
||
;; anschliessend transformiert in der Zeichnung bleibt).
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0))
|
||
blockname 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||
(setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data)))
|
||
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
|
||
(if (not (and ks-ein-raw ks-aus-raw))
|
||
(progn
|
||
(princ (ssg-textf "vfc-fehler-ks-fehlen" (list blockname)))
|
||
(exit)))
|
||
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
|
||
;; bleibt tatsaechlich in der Zeichnung.
|
||
(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))
|
||
(setq xe (cadr f-ein) ye (caddr f-ein) ze (cadddr f-ein))
|
||
(setq P-ein (car f-ein))
|
||
(setq P-aus (car f-aus)
|
||
xu-aus (cadr f-aus)
|
||
yu-aus (caddr f-aus)
|
||
zu-aus (cadddr f-aus))
|
||
;; Rotation identisch zu insert-block-ks-to-ks: R * xe = xt, R * ye = yt, R * ze = zt
|
||
(setq R (mat3-from-frames xt yt zt xe ye ze))
|
||
;; Lokale Referenzpunkte fuer XY- bzw. Z-Zielvorgabe bestimmen
|
||
(setq P-xyref
|
||
(cond ((= xy-ref "KS_EIN") P-ein)
|
||
((= xy-ref "KS_AUS") P-aus)
|
||
(t '(0.0 0.0 0.0))))
|
||
(setq P-zref
|
||
(cond ((= z-ref "KS_EIN") P-ein)
|
||
((= z-ref "KS_AUS") P-aus)
|
||
(t '(0.0 0.0 0.0))))
|
||
(setq R-xyref (mat3-mul-vec3 R P-xyref))
|
||
(setq R-zref (mat3-mul-vec3 R P-zref))
|
||
;; Translation: xy-ref -> P-t (X/Y), z-ref -> z-ziel (Z)
|
||
(setq tx (- (car P-t) (car R-xyref)))
|
||
(setq ty (- (cadr P-t) (cadr R-xyref)))
|
||
(setq tz (- (float z-ziel) (caddr R-zref)))
|
||
;; 4x4-Transformationsmatrix aufbauen und auf Block anwenden
|
||
(setq T4 (vlax-tmatrix
|
||
(list (list (car (car R)) (cadr (car R)) (caddr (car R)) tx)
|
||
(list (car (cadr R)) (cadr (cadr R)) (caddr (cadr R)) ty)
|
||
(list (car (caddr R)) (cadr (caddr R)) (caddr (caddr R)) tz)
|
||
(list 0.0 0.0 0.0 1.0))))
|
||
(vla-TransformBy block-obj T4)
|
||
;; Ausgabe-Rahmen fuer KS_AUS mathematisch berechnen (kein Re-Extrahieren noetig)
|
||
(setq R-Paus (mat3-mul-vec3 R P-aus))
|
||
(setq P-out (list (+ (car R-Paus) tx)
|
||
(+ (cadr R-Paus) ty)
|
||
(+ (caddr R-Paus) tz)))
|
||
(setq xu-out (mat3-mul-vec3 R xu-aus)
|
||
yu-out (mat3-mul-vec3 R yu-aus)
|
||
zu-out (mat3-mul-vec3 R zu-aus))
|
||
(princ (ssg-textf "vfc-block-eingefuegt-xyzref-ksaus"
|
||
(list blockname
|
||
(if xy-ref xy-ref (ssg-text "vfc-ursprung"))
|
||
(if z-ref z-ref (ssg-text "vfc-ursprung"))
|
||
(rtos (car P-out) 2 2) (rtos (cadr P-out) 2 2) (rtos (caddr P-out) 2 2))))
|
||
(list P-out xu-out yu-out zu-out))
|
||
|
||
;; ============================================================
|
||
;; AS-/ES-Element: Winkel-Variante (30 / 90 Grad)
|
||
;; ============================================================
|
||
;; 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)
|
||
(setq blockname (ensure-block-loaded blockname))
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
nil
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||
(setq ke (cadr (assoc "KS_EIN" ks-data)) ka (cadr (assoc "KS_AUS" ks-data)))
|
||
(if (and ke ka)
|
||
(list (- (caar ka) (caar ke))
|
||
(- (cadr (car ka)) (cadr (car ke)))
|
||
(- (caddr (car ka)) (caddr (car ke))))
|
||
nil))))
|
||
|
||
;; Ebenen-Schwenk (Grad) eines Elements: Winkel von KS_EIN.xu nach KS_AUS.xu in
|
||
;; der XY-Ebene, direkt aus dem Block gemessen (unabhaengig davon, ob 30/90-Turn
|
||
;; 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)
|
||
(setq blockname (ensure-block-loaded blockname))
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
90.0
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||
(setq fe (ks-frame-extract (cadr (assoc "KS_EIN" ks-data))))
|
||
(setq fa (ks-frame-extract (cadr (assoc "KS_AUS" ks-data))))
|
||
(if (and fe fa)
|
||
(- (* (atan (cadr (cadr fa)) (car (cadr fa))) (/ 180.0 pi))
|
||
(* (atan (cadr (cadr fe)) (car (cadr fe))) (/ 180.0 pi)))
|
||
90.0))))
|
||
|
||
;; Neigungs-Aenderung (Grad) eines Elements: Winkel von KS_EIN.xu nach
|
||
;; KS_AUS.xu ausserhalb der XY-Ebene (Steigung/Gefaelle), direkt aus dem Block
|
||
;; gemessen - Gegenstueck zu vf-element-plan-turn (das nur die XY-Ebene
|
||
;; misst). Genutzt fuer Faelle, in denen ein Element NICHT mit der
|
||
;; angenommenen *vfk-gefaelle-winkel*-Neigung weitergebaut werden soll,
|
||
;; sondern mit der REALEN, am Block gemessenen Neigung (Nutzer-Vorgabe
|
||
;; 2026-09-13, NUR fuer vfl-qc-linie-mit-gf-uform - siehe dortiger
|
||
;; Kommentar; alle anderen Aufrufer bleiben bei der angenommenen Neigung).
|
||
;; WICHTIG: dieselbe Vorzeichen-Konvention wie frame->hz-winkel (vf_core.lsp)
|
||
;; - "winkel" = atan(-xu.z, horiz), NICHT atan(xu.z, horiz) - positiv heisst
|
||
;; FALLEND (xu zeigt nach unten, negatives Welt-Z), damit der Rueckgabewert
|
||
;; direkt (ohne weiteres Vorzeichen-Umdenken) als winkel-Parameter fuer
|
||
;; vfl-insert-gf-segment/vfl-acc-gf-seg verwendet werden kann - ohne die
|
||
;; Negation kam beim BricsCAD-Test ein KLETTERNDES statt fallendes E1 heraus
|
||
;; (Nutzer-Befund 2026-09-13: reale Neigung maass -3 Grad, ergab ohne
|
||
;; Vorzeichen-Fix ein steigendes statt fallendes Element).
|
||
;; Fallback 0.0 (keine Neigungsaenderung), falls der Block fehlt.
|
||
(defun vf-element-plan-neigung (blockname / temp-obj ks-data fe fa xu-e xu-a horiz-e horiz-a)
|
||
(setq blockname (ensure-block-loaded blockname))
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
0.0
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||
(setq fe (ks-frame-extract (cadr (assoc "KS_EIN" ks-data))))
|
||
(setq fa (ks-frame-extract (cadr (assoc "KS_AUS" ks-data))))
|
||
(if (and fe fa)
|
||
(progn
|
||
(setq xu-e (cadr fe) xu-a (cadr fa))
|
||
(setq horiz-e (sqrt (+ (* (car xu-e) (car xu-e)) (* (cadr xu-e) (cadr xu-e)))))
|
||
(setq horiz-a (sqrt (+ (* (car xu-a) (car xu-a)) (* (cadr xu-a) (cadr xu-a)))))
|
||
(- (* (atan (- (caddr xu-a)) horiz-a) (/ 180.0 pi))
|
||
(* (atan (- (caddr xu-e)) horiz-e) (/ 180.0 pi))))
|
||
0.0))))
|
||
|
||
;; KS-Info eines Elements (im Block, Einbau-Rotation 0):
|
||
;; Rueckgabe (ein-ang aus-ang vx vy)
|
||
;; ein-ang / aus-ang : Ebenen-Winkel (Grad) von KS_EIN.xu bzw. KS_AUS.xu
|
||
;; 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)
|
||
(setq blockname (ensure-block-loaded blockname))
|
||
(if (not (tblsearch "BLOCK" blockname))
|
||
nil
|
||
(progn
|
||
(setq temp-obj (vla-InsertBlock modelspace
|
||
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
|
||
(setq ks-data (extract-ks-from-block temp-obj))
|
||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||
(setq fe (ks-frame-extract (cadr (assoc "KS_EIN" ks-data))))
|
||
(setq fa (ks-frame-extract (cadr (assoc "KS_AUS" ks-data))))
|
||
(if (and fe fa)
|
||
(list (* (atan (cadr (cadr fe)) (car (cadr fe))) (/ 180.0 pi))
|
||
(* (atan (cadr (cadr fa)) (car (cadr fa))) (/ 180.0 pi))
|
||
(- (car (car fa)) (car (car fe)))
|
||
(- (cadr (car fa)) (cadr (car fe))))
|
||
nil))))
|
||
|
||
;; Loest fuer einen Kandidatenwinkel L_GF/L_VF aus den vorberechneten
|
||
;; Groessen A/B (horizontales/vertikales Rest-Budget). Identisch fuer Standard
|
||
;; und Etage - nur die Berechnung von A/B unterscheidet sich (daher als
|
||
;; Parameter). Rueckgabe: Ergebnistabellen-Eintrag (winkel L_GF L_VF gueltig)
|
||
;; bzw. (winkel nil nil nil), wenn keine sinnvolle Loesung existiert.
|
||
;; sin3/cos3 = sin/cos des Basis-Gefaellewinkels (3 Grad); sinEff/cosEff des
|
||
;; effektiven Winkels; sinα des Kandidatenwinkels.
|
||
(defun vf-winkel-solve (winkel richtung A B sinα cosEff sinEff sin3 cos3 / L_GF L_VF gueltig)
|
||
(if (> (abs sinα) 0.0001)
|
||
(progn
|
||
(setq L_GF (/ (- (* A sinEff) (* B cosEff)) sinα))
|
||
(if (= richtung "Auf")
|
||
(setq L_VF (/ (+ (* A sin3) (* B cos3)) sinα))
|
||
(setq L_VF (/ (- (* B cos3) (* A sin3)) sinα))
|
||
)
|
||
(if (and (numberp L_GF) (numberp L_VF))
|
||
(progn
|
||
(setq gueltig (and (>= L_GF 0) (>= L_VF 0)))
|
||
(list winkel L_GF L_VF gueltig))
|
||
(list winkel nil nil nil))
|
||
)
|
||
(list winkel nil nil nil))
|
||
)
|
||
|
||
;; 30/90-Wahl fuer ein AS/ES-Element. Rueckgabe: "30" oder "90" (Vorgabe 90).
|
||
;; headerkey: i18n-Key fuer die Kopfzeile ("vf-winkel-aus-header" oder
|
||
;; "vf-winkel-ein-header"). Rueckgabe: "30" oder "90" (Default 90).
|
||
;; Wizard: nutzt vflw-wahl (dcl/vf_linienzug_wizard.dcl, definiert in
|
||
;; vf_linienzug.lsp) falls dieses Modul geladen und *vfl-wizard-mode* aktiv
|
||
;; ist - sonst (oder bei jedem Fehler) unveraendert die Konsolen-Frage
|
||
;; (getstring, de/en ueber ssg-text). Gemeinsam genutzt von Gefaellestrecke.lsp
|
||
;; UND vf_linienzug.lsp. Druckt selbst KEINE Kopfzeile/Optionstexte mehr (das
|
||
;; macht immer der AUFRUFER, unconditional, VOR diesem Aufruf) - sonst fehlt
|
||
;; die Kopfzeile in der Konsole genau dann, wenn ein vfl-in-value-Wrapper den
|
||
;; Wert bereits aus der Pending-Queue/dem Journal-Replay liest und diese
|
||
;; Funktion dadurch gar nicht erst aufgerufen wird (Inkonsistenz Dialog vs.
|
||
;; Konsole, siehe Aufrufer in vf_linienzug.lsp/Gefaellestrecke.lsp).
|
||
(defun vf-frage-element-winkel (headerkey / antwort)
|
||
;; Wizard-Dialog nur, wenn Wizard-Modus aktiv, vflw-wahl geladen UND die GUI
|
||
;; global nicht abgeschaltet ist (Tests: (ssg-gui-aus)) - sonst Konsole/getstring.
|
||
(if (and (boundp '*vfl-wizard-mode*) *vfl-wizard-mode*
|
||
(car (atoms-family 1 '("VFLW-WAHL")))
|
||
(or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p)))
|
||
(progn
|
||
(setq antwort
|
||
(vl-catch-all-apply 'vflw-wahl
|
||
(list (ssg-text headerkey)
|
||
(list (ssg-text "vf-winkel-90") (ssg-text "vf-winkel-30")) 1)))
|
||
(if (or (vl-catch-all-error-p antwort) (null antwort) (= antwort ""))
|
||
(setq antwort "1"))
|
||
)
|
||
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
|
||
)
|
||
(if (= antwort "2") "30" "90"))
|
||
|
||
;; AS-/ES-Masse-Globals (aus-dx/dy/dz bzw. ein-dx/dy/dz) fuer die gewaehlte
|
||
;; Winkel-/Seiten-Variante neu setzen (fuer berechne-alle-winkel, GF-Winkel,
|
||
;; Trimmungen). Ohne gueltigen Block bleiben die Werte unveraendert.
|
||
(defun vf-set-as-masse (winkel seite / m)
|
||
(setq m (vf-element-masse (strcat "AS_Element_" winkel "_" seite)))
|
||
(if m (setq aus-dx (car m) aus-dy (cadr m) aus-dz (caddr m))))
|
||
;; Fussabdruck eines Elements ENTLANG der Fahrtrichtung (Laengsanteil).
|
||
;;
|
||
;; Warum das nicht (car (vf-element-masse ...)) ist: vf-element-masse liefert
|
||
;; KS_EIN->KS_AUS im BLOCK-Koordinatensystem. Ein Element wird aber so gedreht
|
||
;; eingebaut, dass sein KS_EIN auf der Fahrtrichtung liegt (insert-block-ks-to-ks
|
||
;; bzw. insert-block-by-ks mit (hz - ein-ang)). Bei einem drehenden Element -
|
||
;; ES_Element_30 hat ein-ang = 120 Grad - landet dadurch ein TEIL der
|
||
;; Block-Y-Komponente auf der Fahrtrichtung, und die Block-X-Komponente allein
|
||
;; unterschaetzt den Laengsverbrauch massiv: beim ES_Element_30_rechts 242.6 mm
|
||
;; statt tatsaechlich 576.2 mm (realer Bug, Nutzer-Befund 2026-10-09: die Kette
|
||
;; ragte 333.65 mm ueber den gepickten Endpunkt hinaus).
|
||
;;
|
||
;; Die Projektion ist hz-UNABHAENGIG (der Einbauwinkel kuerzt sich heraus), sie
|
||
;; haengt nur am blockinternen ein-ang:
|
||
;; laengs = vx*cos(ein-ang) + vy*sin(ein-ang)
|
||
;; Gleiche Rechnung wie etage-laengs in vf_etage.lsp mit d = -ein-ang, dort fuer
|
||
;; die Rand-Bilanz des Etage-Typs.
|
||
;;
|
||
;; Rueckgabe: Laenge in mm, oder nil wenn der Block/sein KS fehlt (Aufrufer
|
||
;; faellt dann auf das alte Verhalten zurueck).
|
||
(defun vf-element-laengs (blockname / i rad)
|
||
(setq i (vf-element-ks-info blockname))
|
||
(if (null i)
|
||
nil
|
||
(progn
|
||
(setq rad (* (car i) (/ pi 180.0)))
|
||
(+ (* (caddr i) (cos rad)) (* (cadddr i) (sin rad))))))
|
||
|
||
;; Gegenstueck zu vf-element-laengs: Versatz QUER zur Fahrtrichtung.
|
||
;; quer = -vx*sin(ein-ang) + vy*cos(ein-ang)
|
||
;; Ebenfalls hz-unabhaengig. Beim ES_Element_30 sind das rund -52.5 mm - der
|
||
;; seitliche Versatz, mit dem das ES-KS_AUS neben der Fahrtachse landet. Er
|
||
;; wird NICHT ausgeglichen (der Hauptstrang bleibt gerade, Nutzer-Entscheidung
|
||
;; 2026-09-15), aber er muss BEKANNT sein: die Bahn des ES-KS_AUS verlaeuft um
|
||
;; genau diesen Betrag seitlich versetzt, und nur mit ihm trifft die
|
||
;; Schnittpunkt-Rechnung gegen eine Ziellinie die richtige Stelle.
|
||
(defun vf-element-quer (blockname / i rad)
|
||
(setq i (vf-element-ks-info blockname))
|
||
(if (null i)
|
||
nil
|
||
(progn
|
||
(setq rad (* (car i) (/ pi 180.0)))
|
||
(+ (* (- (caddr i)) (sin rad)) (* (cadddr i) (cos rad))))))
|
||
|
||
;; Setzt ein-dx/ein-dy/ein-dz (BLOCK-Koordinaten, fuer Quer-/Hoehenrechnungen)
|
||
;; und zusaetzlich ein-laengs: den Fussabdruck ENTLANG der Fahrtrichtung. Wer
|
||
;; eine Laenge von deltaL reserviert, nimmt ein-laengs - NICHT (abs ein-dx),
|
||
;; siehe vf-element-laengs.
|
||
(defun vf-set-es-masse (winkel seite / m blk)
|
||
(setq blk (strcat "ES_Element_" winkel "_" seite))
|
||
(setq m (vf-element-masse blk))
|
||
(if m (setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m)))
|
||
;; Fallback auf das alte (zu kleine) Mass, wenn das KS nicht lesbar ist -
|
||
;; lieber etwas zu kurz reservieren als gar nicht bauen koennen.
|
||
(setq ein-laengs (vf-element-laengs blk))
|
||
(if (and (null ein-laengs) m) (setq ein-laengs (abs (car m))))
|
||
;; ein-quer: seitlicher Versatz des ES-KS_AUS zur Fahrtachse (siehe
|
||
;; vf-element-quer). Wird fuer die Ziellinien-Schnittpunktrechnung gebraucht.
|
||
(setq ein-quer (vf-element-quer blk))
|
||
(if (null ein-quer) (setq ein-quer 0.0))
|
||
ein-laengs)
|
||
|
||
|
||
;; ============================================================
|
||
;; TEIL 9: GEMEINSAME EINGABE-ABFRAGE
|
||
;; ============================================================
|
||
|
||
;; Feld-Reihenfolge der Basis-Dialog-Ergebnisliste (vfs-dialog-eingabe-basis).
|
||
;; EINE zentrale Definition statt vierfach denselben (nth i eingabe)-Block.
|
||
(setq *vf-basis-eingabe-felder*
|
||
'(deltaL deltaH richtung z-start hz seite dim geruest-einzelmodul geruest-typ motorseite))
|
||
|
||
;; Entpackt die Basis-Dialog-Ergebnisliste in die gleichnamigen (dynamisch
|
||
;; skopten) Lokalvariablen des Aufrufers. Ersetzt den 10-zeiligen
|
||
;; (setq deltaL (nth 0 eingabe) ...)-Block. Nutzt (set 'sym wert): die Symbole
|
||
;; sind in der /-Deklaration des aufrufenden defun als Locals gebunden, daher
|
||
;; wirkt das Setzen nur dort (AutoLISP dynamic scoping).
|
||
(defun vf-basis-eingabe-entpacken (eingabe / i)
|
||
(setq i 0)
|
||
(foreach feld *vf-basis-eingabe-felder*
|
||
(set feld (nth i eingabe))
|
||
(setq i (1+ i)))
|
||
eingabe)
|
||
|
||
;; 3D-Linie picken und daraus deltaL/deltaH/richtung/hz/startpunkt (inkl. Z)
|
||
;; ableiten - fuer den GUI-Ablauf (vf-dialog-ablauf): ersetzt dort die
|
||
;; separate Startpunkt-Auswahl UND liefert die Geometrie-Felder als Prefill
|
||
;; fuer den Basis-Dialog (vfs-dialog-eingabe-basis). Rueckgabe: (deltaL
|
||
;; deltaH richtung startpunkt hz) oder nil, wenn keine gueltige Linie
|
||
;; gewaehlt wurde (Aufrufer bricht dann ab, statt wie frueher per (exit)
|
||
;; die ganze Befehlssitzung zu beenden).
|
||
(defun vfc-3dlinie-erfassen ( / line-points startpunkt endpunkt differenz
|
||
deltaL deltaH deltaX deltaY richtung hz-winkel)
|
||
(princ (ssg-text "vfc-modus-3dlinie-header"))
|
||
(command "BKS" "W")
|
||
(princ (ssg-text "vfc-bks-weltkoordinaten"))
|
||
(setq line-points
|
||
(get-line-start-end-points (ssg-text "vfc-bitte-3dlinie-foerderstrecke")))
|
||
(if (null line-points)
|
||
(progn (alert (ssg-text "vfc-alert-keine-gueltige-linie")) nil)
|
||
(progn
|
||
(setq startpunkt (car line-points)
|
||
endpunkt (cadr line-points))
|
||
(setq differenz (punkt-differenz startpunkt endpunkt))
|
||
(setq deltaX (abs (car differenz))
|
||
deltaY (abs (cadr differenz))
|
||
deltaH (caddr differenz))
|
||
(setq deltaL (max deltaX deltaY))
|
||
;; Fahrtrichtung aus der Linie ableiten (0=Ost, 90=Nord, ...)
|
||
(setq hz-winkel
|
||
(* (angle '(0.0 0.0) (list (car differenz) (cadr differenz))) (/ 180.0 pi)))
|
||
(princ (ssg-textf "vfc-delta-l-h-richtung"
|
||
(list (chr 916) (rtos deltaL 2 2) (rtos deltaH 2 2) (rtos hz-winkel 2 1) grad-zeichen)))
|
||
(if (>= deltaH 0)
|
||
(progn (setq richtung "Auf") (princ (ssg-text "vfc-foerderrichtung-auf")))
|
||
(progn (setq richtung "Ab") (setq deltaH (abs deltaH))
|
||
(princ (ssg-text "vfc-foerderrichtung-ab")))
|
||
)
|
||
;; Einfuegehoehe (Z des Startpunkts) wird NICHT mehr hier auf der
|
||
;; Konsole abgefragt - sie geht als Prefill "einfuegehoehe" in den
|
||
;; Basis-Dialog (vfs-dialog-eingabe-basis) ein, der dasselbe Feld
|
||
;; ohnehin per GUI anzeigt und ueberschreibbar macht (Vorschlag = Z
|
||
;; des Linien-Startpunkts, wie zuvor beim getreal-Prompt).
|
||
(list deltaL deltaH richtung startpunkt hz-winkel)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 10: VF_*-BLOCK-SYSTEM (gemeinsam fuer alle Typen)
|
||
;; ============================================================
|
||
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...) - siehe
|
||
;; variofoerderer-einfuegen. Beschriftungsposition wird ENTLANG dieser
|
||
;; Richtung (halbe deltaL) und SENKRECHT dazu (200mm) versetzt, statt fest
|
||
;; von +X auszugehen. Der Textwinkel rastet wie bei Gefaellestrecke immer
|
||
;; auf 0 Grad (X-Achse) oder 90 Grad (Y-Achse) ein, damit er nie auf dem
|
||
;; Kopf steht - unabhaengig von der tatsaechlichen Fahrtrichtung.
|
||
;; L_GF1/L_GF2: die beiden Gefaellestrecken-Segmente (vorne/hinten) - werden
|
||
;; als kommagetrennte Meter-Werte dargestellt (Punkt=Dezimaltrennzeichen,
|
||
;; Komma=Segment-Trenner, analog L-gf-str in Gefaellestrecke.lsp), damit
|
||
;; beide Werte eindeutig unterscheidbar bleiben.
|
||
(defun vf-make-label (vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
|
||
richtung best-winkel n-separator n-scanner startpunkt hz /
|
||
label-txt label-pt L_VF_str L_GF_str delta-sym
|
||
chz-l shz-l halb basis-winkel lay)
|
||
(setq delta-sym (chr 916))
|
||
(setq L_VF_str (vl-string-subst "," "." (rtos (/ L_VF 1000.0) 2 3)))
|
||
(setq L_GF_str (strcat (rtos (/ L_GF1 1000.0) 2 3) "," (rtos (/ L_GF2 1000.0) 2 3)))
|
||
(setq label-txt
|
||
(strcat "VF" (itoa vf-nummer)
|
||
(ssg-textf "vfc-label-von-bis" (list (itoa (fix hoehe-von)) (itoa (fix hoehe-bis))))
|
||
delta-sym "H=" (itoa (fix deltaH)) "mm; "
|
||
delta-sym "L=" (itoa (fix deltaL)) "mm; "
|
||
"VF:" L_VF_str "m; GF:" L_GF_str "m; "
|
||
richtung ": " (itoa best-winkel) grad-zeichen "; "
|
||
"Sep: " (itoa n-separator) "; Scan: " (itoa n-scanner)))
|
||
(setq chz-l (cos (* (float hz) (/ pi 180.0))))
|
||
(setq shz-l (sin (* (float hz) (/ pi 180.0))))
|
||
(setq halb (/ (float deltaL) 2.0))
|
||
(setq label-pt (list
|
||
(+ (car startpunkt) (* halb chz-l) (* *vfk-label-versatz* shz-l))
|
||
(+ (cadr startpunkt) (* halb shz-l) (* (- *vfk-label-versatz*) chz-l))
|
||
(caddr startpunkt)))
|
||
;; Textwinkel auf 0/90 Grad einrasten (nie kopfueber, unabhaengig von hz)
|
||
(setq basis-winkel (float hz))
|
||
(while (< basis-winkel 0.0) (setq basis-winkel (+ basis-winkel 360.0)))
|
||
(while (>= basis-winkel 360.0) (setq basis-winkel (- basis-winkel 360.0)))
|
||
(if (>= basis-winkel 180.0) (setq basis-winkel (- basis-winkel 180.0)))
|
||
(setq basis-winkel (if (or (< basis-winkel 45.0) (>= basis-winkel 135.0)) 0.0 90.0))
|
||
;; Beschriftungs-Layer aus cfg/layer.cfg (Baugruppe "vf_beschriftung"), sonst
|
||
;; der bisherige Hartwert. Der Layer wird hier ANGELEGT - bisher schrieb das
|
||
;; entmake unten auf einen Layer, den niemand erzeugt hat.
|
||
(setq lay (ssg-layer-anlegen "vf_beschriftung" nil))
|
||
(if (null lay)
|
||
(progn
|
||
(setq lay "VF_Beschriftung")
|
||
(ssg-make-layer lay "7" nil)
|
||
)
|
||
)
|
||
(entmake (list
|
||
'(0 . "TEXT")
|
||
(cons 8 lay)
|
||
'(67 . 0)
|
||
(cons 10 label-pt)
|
||
(cons 40 *vfk-label-texthoehe*)
|
||
(cons 1 label-txt)
|
||
(cons 50 (* basis-winkel (/ pi 180.0)))
|
||
'(72 . 1)
|
||
'(73 . 2)
|
||
(cons 11 label-pt)
|
||
))
|
||
)
|
||
|
||
;; --- Gemeinsamer VF_n-Wrapper-Rumpf (Standard/Etage UND Linienzug) ----------
|
||
;; Der frueher in vf-block-erstellen (vf_core) und vfl-block-erstellen
|
||
;; (vf_linienzug) wortgleiche Rumpf: unsichtbare ATTDEFs am Startpunkt nach dem
|
||
;; gemeinsamen Strecken-Schema erzeugen, alle seit lastEnt neu entstandenen
|
||
;; Entities einsammeln, die Sepliste sichern, per ssg-block-wrap-welt zu einem
|
||
;; Block VF_n wickeln, auf den Baugruppen-Layer legen, Sepliste-XDATA + die
|
||
;; uebergebene Attributliste + ID + Dimensions-XDATA schreiben.
|
||
;;
|
||
;; typ-str = "Streckengruppe"/"Gefaellestrecke" (steuert nur ssg-strecke-attrib-
|
||
;; defs, das Attribut-Schema). attrib-liste = FERTIGE (tag . wert)-Liste, die
|
||
;; der Aufrufer baut (feste Werte bei Standard/Etage, *vfl-acc-*-Komma-Listen
|
||
;; beim Linienzug) - der gemeinsame Rumpf kennt die Semantik NICHT.
|
||
;; ATTDEF-Format: kanonisch (wie vfl-block-erstellen/Gefaellestrecke/
|
||
;; Vario_Kette_Merge - 3 von 4 Bauern nutzten es schon; vf-block-erstellen war
|
||
;; der Ausreisser mit Layer-0/Model-Space-Zwang + y-Dekrementierung ohne
|
||
;; belegbaren Zweck bei unsichtbaren ATTDEFs).
|
||
;; Rueckgabe: die Block-Referenz (vf-insert) oder nil, wenn seit lastEnt nichts
|
||
;; entstand (Leere-Menge-Schutz, frueher nur in vf-block-erstellen).
|
||
(defun vf-wrapper-bauen (vf-nummer typ-str startpunkt lastEnt attrib-liste
|
||
/ vf-bname vf-ss vf-e vf-insert vf-sepliste)
|
||
(setq vf-bname (strcat "VF_" (itoa vf-nummer)))
|
||
;; Unsichtbare ATTDEFs (kanonisches Format) am Startpunkt.
|
||
(foreach def (ssg-strecke-attrib-defs typ-str)
|
||
(entmake
|
||
(list '(0 . "ATTDEF")
|
||
(cons 10 startpunkt)
|
||
(cons 11 startpunkt)
|
||
(cons 40 *vfk-attdef-texthoehe*)
|
||
(cons 1 (cadr def))
|
||
(cons 2 (car def))
|
||
(cons 3 (car def))
|
||
'(70 . 1)
|
||
'(72 . 0)
|
||
'(74 . 0)))
|
||
)
|
||
;; Alle neuen Entities seit lastEnt sammeln.
|
||
(setq vf-ss (ssadd))
|
||
(setq vf-e (if lastEnt (entnext lastEnt) (entnext)))
|
||
(while vf-e (ssadd vf-e vf-ss) (setq vf-e (entnext vf-e)))
|
||
;; Sepliste VOR dem Sweep sichern (danach existieren die Sub-Entities nicht
|
||
;; mehr einzeln).
|
||
(setq vf-sepliste (ssg-sepliste-sammeln lastEnt))
|
||
(if (> (sslength vf-ss) 0)
|
||
(progn
|
||
(setq vf-insert (ssg-block-wrap-welt vf-bname startpunkt vf-ss))
|
||
(ssg-layer-setzen vf-insert "variofoerderer")
|
||
(ssg-sepliste-xdata-schreiben vf-insert "SSG_VF_SEP" vf-sepliste)
|
||
(ssg-attrib-set-on vf-insert attrib-liste)
|
||
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
|
||
(ssg-id-generate vf-insert))
|
||
(if (car (atoms-family 1 '("SSG-DIM-XDATA-SCHREIBEN")))
|
||
(ssg-dim-xdata-schreiben vf-insert (ssg-ils-dim-aktuell)))
|
||
vf-insert)
|
||
(progn (princ (ssg-text "vfc-fehler-keine-entities")) nil)))
|
||
|
||
;; Erstellt VF_N-Block aus allen seit lastEnt erzeugten Entities.
|
||
;; Setzt Attributwerte entsprechend Typ, Seite und Geometrieparametern.
|
||
(defun vf-block-erstellen (anlage-typ seite vf-nummer n-scanner
|
||
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
|
||
richtung best-winkel startpunkt lastEnt hz
|
||
geruest-einzelmodul geruest-typ
|
||
/ vf-insert montagehoehe-m L_GF_m-str)
|
||
(if (null hz) (setq hz 0.0))
|
||
(if (null geruest-einzelmodul) (setq geruest-einzelmodul "1"))
|
||
(if (null geruest-typ) (setq geruest-typ (ssg-geruest-idx-to-typ (ssg-geruest-typ-to-idx nil))))
|
||
;; Beschriftungstext erzeugen (VOR dem Wrapper-Bau, damit er mit eingesammelt
|
||
;; wird - Standard/Etage-spezifisch, der Linienzug hat kein solches Label).
|
||
(vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
|
||
richtung best-winkel 2 n-scanner startpunkt hz)
|
||
(setq montagehoehe-m (/ (+ hoehe-von hoehe-bis) 2000.0))
|
||
;; L_GF_m: kommagetrennte Segmentlaengen in Metern (vorne,hinten),
|
||
;; analog L_GF_m in Gefaellestrecke.lsp.
|
||
(setq L_GF_m-str (strcat (rtos (/ L_GF1 1000.0) 2 3) "," (rtos (/ L_GF2 1000.0) 2 3)))
|
||
;; Standard/Etage-Attributsatz (feste Werte). VarioFoerderer ist immer TYP
|
||
;; "Streckengruppe" -> voller Attributsatz. Etage-Sonderfall (2x Gefaellebogen
|
||
;; je Seite) direkt in die Liste, statt als zweiter ssg-attrib-set-on-Aufruf.
|
||
(setq vf-insert
|
||
(vf-wrapper-bauen vf-nummer "Streckengruppe" startpunkt lastEnt
|
||
(append
|
||
(list
|
||
(cons "Bezeichnung" (strcat "VF_" (itoa vf-nummer)))
|
||
;; ARTINR bleibt auf Schema-Vorgabe "6220"
|
||
(cons "MONTAGEHOEHE_m" (rtos montagehoehe-m 2 3))
|
||
(cons "HOEHE_VON_mm" (itoa (fix hoehe-von)))
|
||
(cons "HOEHE_BIS_mm" (itoa (fix hoehe-bis)))
|
||
(cons "DELTA_H_mm" (itoa (fix deltaH)))
|
||
(cons "DELTA_L_mm" (itoa (fix deltaL)))
|
||
(cons "TYP" "Streckengruppe")
|
||
(cons "SEITE_AS" seite)
|
||
(cons "WINKEL_AS" (if (= anlage-typ "etage") "30" "90"))
|
||
(cons "SEITE_ES" seite)
|
||
(cons "WINKEL_ES" (if (= anlage-typ "etage") "30" "90"))
|
||
(cons "ANZAHL_GF" "2") ; GF1 + GF2
|
||
(cons "L_GF_m" L_GF_m-str)
|
||
;; GF_WINKEL: Neigung je GF-Segment (GF1,GF2 - beide feste Grundneigung)
|
||
(cons "GF_WINKEL" (strcat (rtos (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) 2 1)
|
||
"," (rtos (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)) 2 1)))
|
||
(cons "ANZAHL_VF" "1") ; ein VF-Koerper
|
||
(cons "MOTORSEITE" (vf-motorseite-aktuell))
|
||
(cons "L_VF_m" (rtos (/ L_VF 1000.0) 2 3))
|
||
(cons "ANTRIEBFAHRTRICHTUNG" richtung)
|
||
(cons "VF_WINKEL" (itoa best-winkel))
|
||
(cons "ANZAHL_SEPARATOR" "2")
|
||
(cons "ANZAHL_SCANNER" (itoa n-scanner))
|
||
(cons "GERUEST_EINZELMODUL" geruest-einzelmodul)
|
||
(cons "GERUEST_TYP" geruest-typ))
|
||
;; Typ-spezifische Bogen-Zaehler (Etage: 2x Gefaellebogen je Seite)
|
||
(if (= anlage-typ "etage")
|
||
(if (= seite "rechts")
|
||
(list (cons "GF_Bogen_R_60" "2"))
|
||
(list (cons "GF_Bogen_L_60" "2")))
|
||
'()))))
|
||
(if vf-insert
|
||
(princ (ssg-textf "vfc-block-erstellt-eingefuegt" (list (strcat "VF_" (itoa vf-nummer))))))
|
||
vf-insert
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 10b: GEMEINSAMER DIALOG-ABLAUF (Standard + Etage)
|
||
;; ============================================================
|
||
;; Standard- und Etage-Typ teilen denselben Neuanlage-/Berechnen-Einfuege-
|
||
;; Ablauf; sie unterscheiden sich nur in Berechnungs-/Einfuege-Funktion (aus
|
||
;; der Typ-Registry), im XDATA-Marker und darin, ob die horizontale
|
||
;; Zwischenstrecke (nur "Ab") als Zusatzoption angeboten wird.
|
||
;; berechne-fn/einfuege-fn kommen aus *vf-typ-registry* (via typ).
|
||
(defun vf-registry-berechne-fn (typ) (nth 1 (assoc typ *vf-typ-registry*)))
|
||
(defun vf-registry-einfuege-fn (typ) (nth 2 (assoc typ *vf-typ-registry*)))
|
||
|
||
;; Gemeinsame Berechnung + Winkel/Verteilung-Dialog + Einfuegung fuer einen
|
||
;; Registry-Typ. horizontal-p = T: horizontale Zwischenstrecke (Winkel 0) als
|
||
;; Zusatzoption bei "Ab" anbieten (Standard); nil: nicht (Etage).
|
||
;; Rueckgabe: (vf-insert vf-endpunkt), bei Abbruch (nil nil).
|
||
(defun vf-dialog-berechnen-einfuegen (typ vf-nummer deltaL deltaH richtung startpunkt hz seite
|
||
winkel-prefill geruest-einzelmodul geruest-typ horizontal-p /
|
||
berechne-fn einfuege-fn ergebnis ergebnis-liste gueltige-winkel
|
||
horizontal-info winkelwahl best-winkel L_GF L_VF L_GF1 L_GF2
|
||
verteilung-modus n-scanner hoehe-von hoehe-bis lastEnt
|
||
vf-insert vf-endpunkt staustrecke-basis)
|
||
(setq berechne-fn (vf-registry-berechne-fn typ))
|
||
(setq einfuege-fn (vf-registry-einfuege-fn typ))
|
||
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
|
||
(setq ergebnis-liste (cadddr ergebnis))
|
||
(setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
|
||
|
||
;; Horizontale Zwischenstrecke als Zusatzoption (nur bei "Ab", nur wenn
|
||
;; horizontal-p). Winkel-Sentinel 0.
|
||
(setq horizontal-info nil)
|
||
(if (and horizontal-p (= richtung "Ab"))
|
||
(progn
|
||
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab" nil))
|
||
(if (and horizontal-info (caddr horizontal-info))
|
||
(setq ergebnis-liste
|
||
(append ergebnis-liste (list (list 0 (car horizontal-info) (cadr horizontal-info) T))))
|
||
(setq horizontal-info nil)
|
||
)
|
||
)
|
||
)
|
||
|
||
(setq gueltige-winkel
|
||
(mapcar 'car
|
||
(vl-remove-if-not
|
||
(function (lambda (e) (and (nth 3 e) (numberp (nth 1 e)) (numberp (nth 2 e))
|
||
(>= (nth 1 e) 0) (>= (nth 2 e) 0))))
|
||
ergebnis-liste)))
|
||
|
||
(if (null gueltige-winkel)
|
||
(alert (ssg-textf "vfc-alert-kein-winkel"
|
||
(list (chr 916) (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
|
||
(progn
|
||
(setq winkelwahl (vfs-dialog-winkel-verteilung gueltige-winkel ergebnis-liste staustrecke-basis winkel-prefill))
|
||
(if (null winkelwahl)
|
||
(princ (ssg-text "vfc-vorgang-abgebrochen"))
|
||
(progn
|
||
(setq best-winkel (nth 0 winkelwahl)
|
||
L_GF (nth 1 winkelwahl)
|
||
L_VF (nth 2 winkelwahl)
|
||
L_GF1 (nth 3 winkelwahl)
|
||
L_GF2 (nth 4 winkelwahl)
|
||
verteilung-modus (nth 5 winkelwahl))
|
||
(setq n-scanner 0)
|
||
(setq hoehe-von (caddr startpunkt))
|
||
(setq hoehe-bis
|
||
(cond ((= richtung "Auf") (+ hoehe-von deltaH))
|
||
((= richtung "Ab") (- hoehe-von deltaH))
|
||
(t hoehe-von)))
|
||
(setq lastEnt (ssg-lastent-ohne-attribute))
|
||
(setq vf-endpunkt
|
||
(apply einfuege-fn
|
||
(list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz)))
|
||
(setq vf-insert
|
||
(vf-block-erstellen typ seite vf-nummer n-scanner
|
||
hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
|
||
richtung best-winkel startpunkt lastEnt hz
|
||
geruest-einzelmodul geruest-typ))
|
||
(if vf-insert (vf-edit-xdata-schreiben vf-insert typ hz))
|
||
(princ "\n=========================================")
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(list vf-insert vf-endpunkt)
|
||
)
|
||
|
||
;; Startpunkt der Anlage per Dialog waehlen (Punktwahl-Button + Anzeige,
|
||
;; dcl/variofoerderer.dcl Tile vfc_startpunkt) - dasselbe "Schliessen-
|
||
;; Picken-Neu-Zeigen"-Muster wie der Linienzug-Wizard
|
||
;; (vflw-gruppe-punkt-hoehe-impl, vf_linienzug.lsp:697), aber ohne dessen
|
||
;; Wizard-Pending-Queue: der Punkt wird direkt zurueckgegeben. kopf/
|
||
;; pt_anzeige kommen per set_tile aus ssg-text - anders als
|
||
;; vfc-dialog-typ-waehlen also KEIN *ssg-lang*-Gate noetig, der Dialog
|
||
;; funktioniert in jeder Sprache. Rueckgabe: Punkt (Liste X Y Z) oder nil,
|
||
;; wenn kein Dialog gezeigt werden konnte/durfte (GUI aus) ODER abgebrochen
|
||
;; wurde - der Aufrufer (vf-dialog-ablauf) faellt dann auf den alten
|
||
;; Konsolen-getpoint zurueck.
|
||
(defun vfc-dialog-startpunkt-waehlen (kopf-key / dcl-pfad dat ergebnis gpunkt fertig)
|
||
(if (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
|
||
(progn
|
||
(setq fertig nil)
|
||
(while (not fertig)
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vfc_startpunkt" dat))
|
||
(progn
|
||
(if (and dat (>= dat 0)) (unload_dialog dat))
|
||
(setq fertig t gpunkt nil)
|
||
)
|
||
(progn
|
||
(set_tile "kopf" (ssg-text "vfc-dlg-startpunkt-kopf"))
|
||
(if gpunkt
|
||
(set_tile "pt_anzeige"
|
||
(strcat "X=" (rtos (car gpunkt) 2 1)
|
||
" Y=" (rtos (cadr gpunkt) 2 1)
|
||
" Z=" (rtos (caddr gpunkt) 2 1)))
|
||
)
|
||
(action_tile "pick" "(done_dialog 2)")
|
||
(action_tile "accept" "(done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(cond
|
||
((= ergebnis 2) (setq gpunkt (getpoint (ssg-text kopf-key))))
|
||
((= ergebnis 1) (setq fertig t))
|
||
(t (setq fertig t gpunkt nil))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
gpunkt
|
||
)
|
||
nil
|
||
)
|
||
)
|
||
|
||
;; Neuanlage (Menue/Konsole -> Dialog) fuer einen Registry-Typ. Zwei
|
||
;; Eingabemodi fuer die Geometrie (deltaL/deltaH/richtung/hz/Startpunkt):
|
||
;; "1" 3D-Linie: Linie picken (vfc-3dlinie-erfassen), die abgeleiteten
|
||
;; Werte gehen als Prefill in den Basis-Dialog - NUR Seite/
|
||
;; Motorseite/Darstellung/Geruest bleiben dort fuer den Anwender offen.
|
||
;; "2" Werte: wie bisher Startpunkt (X/Y) picken, Basis-Dialog ohne
|
||
;; Geometrie-Prefill (Defaults).
|
||
;; Eingabemodus kommt per Vorauswahl (Menue-Wrapper c:StandardVarioFoerderer3D
|
||
;; / c:EtageVarioFoerderer3D setzen *vf-vorauswahl-eingabemodus* "1"/"2") oder
|
||
;; wird - wie zuvor im Konsolen-Ablauf - interaktiv erfragt; die Vorauswahl
|
||
;; gilt nur einmal. Ersetzt den frueheren Rueckfall auf den rein interaktiven
|
||
;; Konsolen-Ablauf (vf-eingabe-abfragen, entfernt) fuer die 3D-Linie: dieser
|
||
;; lief komplett an der GUI vorbei und fragte Seite/Fahrtrichtung/etc. erneut
|
||
;; auf der Kommandozeile ab, obwohl der Basis-Dialog dieselben Felder laengst
|
||
;; per GUI anbietet.
|
||
(defun vf-dialog-ablauf (typ vf-nummer horizontal-p / eingabe deltaL deltaH richtung
|
||
z-start hz seite startpunkt startpunkt-xy dim
|
||
geruest-einzelmodul geruest-typ motorseite
|
||
antwort dlg-modus linie-erg basis-prefill abbruch)
|
||
(setq abbruch nil)
|
||
(if *vf-vorauswahl-eingabemodus*
|
||
(setq antwort *vf-vorauswahl-eingabemodus*
|
||
*vf-vorauswahl-eingabemodus* nil)
|
||
(progn
|
||
(setq dlg-modus (vfc-dialog-eingabemodus-waehlen))
|
||
(cond
|
||
((eq dlg-modus 'ABBRUCH) (setq antwort "2" abbruch t))
|
||
(dlg-modus (setq antwort dlg-modus))
|
||
(t
|
||
;; Dialog nicht verfuegbar/nicht erlaubt (GUI aus, andere Sprache)
|
||
;; - alte Konsolen-Abfrage unveraendert.
|
||
(princ (ssg-text "vfc-eingabemodus-header"))
|
||
(princ (ssg-text "vfc-eingabemodus-3dlinie"))
|
||
(princ (ssg-text "vfc-eingabemodus-werte"))
|
||
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(if (not abbruch)
|
||
(if (= antwort "1")
|
||
(progn
|
||
(setq linie-erg (vfc-3dlinie-erfassen))
|
||
(if (null linie-erg)
|
||
(setq abbruch t)
|
||
(progn
|
||
(setq deltaL (nth 0 linie-erg)
|
||
deltaH (nth 1 linie-erg)
|
||
richtung (nth 2 linie-erg)
|
||
startpunkt (nth 3 linie-erg)
|
||
hz (nth 4 linie-erg))
|
||
(setq basis-prefill
|
||
(list (cons "deltaL" deltaL) (cons "deltaH" deltaH) (cons "richtung" richtung)
|
||
(cons "einfuegehoehe" (caddr startpunkt)) (cons "hz" hz)))
|
||
)
|
||
)
|
||
)
|
||
(progn
|
||
(setq startpunkt-xy (vfc-dialog-startpunkt-waehlen "vfc-prompt-startpunkt-aus"))
|
||
(if (null startpunkt-xy)
|
||
(setq startpunkt-xy (getpoint (ssg-text "vfc-prompt-startpunkt-aus"))))
|
||
(if (null startpunkt-xy) (setq startpunkt-xy '(0 0 0)))
|
||
(setq startpunkt startpunkt-xy)
|
||
(setq basis-prefill nil)
|
||
)
|
||
)
|
||
)
|
||
(if abbruch
|
||
(princ (ssg-text "vfc-vorgang-abgebrochen"))
|
||
(progn
|
||
(setq eingabe (vfs-dialog-eingabe-basis basis-prefill))
|
||
(if (null eingabe)
|
||
(princ (ssg-text "vfc-vorgang-abgebrochen"))
|
||
(progn
|
||
(vf-basis-eingabe-entpacken eingabe)
|
||
;; X/Y kommen aus dem Linien-Startpunkt (Modus 1) oder der
|
||
;; separaten Punktwahl (Modus 2); Z immer aus dem Basis-Dialog
|
||
;; (dort vorbelegt, aber ueberschreibbar).
|
||
(setq startpunkt (list (car startpunkt) (cadr startpunkt) z-start))
|
||
;; Gewaehlte Dimension (2D/3D) + Motorseite fuer den Bau erzwingen, danach zurueck.
|
||
(setq *ssg-ils-dim* dim)
|
||
(setq *vf-motorseite* motorseite)
|
||
(vf-dialog-berechnen-einfuegen typ vf-nummer deltaL deltaH richtung startpunkt hz seite nil
|
||
geruest-einzelmodul geruest-typ horizontal-p)
|
||
(setq *ssg-ils-dim* nil)
|
||
(setq *vf-motorseite* nil)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 11: UNTERMODULE LADEN
|
||
;; ============================================================
|
||
;; Guard: Untermodule nur beim ersten Laden von vf_core.lsp ausfuehren.
|
||
(if (not *ssg-vf-submodule-loaded*)
|
||
(progn
|
||
(princ "\n>>> VarioFoerderer geladen")
|
||
;; Lisp-Pfad zentral ueber ssg_core (ssg_core ist hier bereits geladen).
|
||
(setq *vf-lisp-pfad* (ssg-lisp-verzeichnis))
|
||
(if *vf-lisp-pfad*
|
||
(progn
|
||
(load (strcat *vf-lisp-pfad* "/vf_konstanten.lsp"))
|
||
(load (strcat *vf-lisp-pfad* "/vf_standard.lsp"))
|
||
(load (strcat *vf-lisp-pfad* "/vf_etage.lsp"))
|
||
(load (strcat *vf-lisp-pfad* "/vf_linienzug.lsp"))
|
||
;; vf_spec baut Ketten aus Eingabedaten (Spec -> Journal ->
|
||
;; Replay) und braucht dafuer vf_linienzug - darum ZULETZT.
|
||
;; Hier geladen und nicht im MNL, weil damit beide Ladewege
|
||
;; abgedeckt sind (Menue ueber VarioFoerderer.lsp und der
|
||
;; Headless-Loader Lisp/ssg_load.lsp fuer .scr-Testlaeufe).
|
||
(load (strcat *vf-lisp-pfad* "/vf_spec.lsp"))
|
||
(setq *ssg-vf-submodule-loaded* t)
|
||
)
|
||
(princ (ssg-text "vfc-warnung-untermodule-nicht-geladen"))
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 11b: DIALOG-AUSWAHL FUER TYP (Radio-Buttons)
|
||
;; ============================================================
|
||
;; Ersetzt die Konsolen-Liste am Anfang von c:VarioFoerderer durch einen
|
||
;; Radio-Button-Dialog (dcl/variofoerderer.dcl, vfc_typ) - alle Optionen
|
||
;; sofort sichtbar statt Dropdown. WICHTIG: Radio-Button-
|
||
;; Labels sind im DCL fest auf Deutsch einprogrammiert (set_tile kann das
|
||
;; Label eines radio_button nicht setzen, nur den Zustand - siehe DCL-
|
||
;; Kommentar). Die Funktion gibt deshalb nur dann etwas anderes als nil
|
||
;; zurueck, wenn GUI erlaubt ist (Tests: ssg-gui-aus) UND Deutsch aktiv ist -
|
||
;; sonst faellt der Aufrufer automatisch auf die alte, vollstaendig
|
||
;; uebersetzte Konsolen-Liste zurueck (unveraendert im Code stehen
|
||
;; geblieben). Rueckgabe jeweils: Ergebnis bei OK, 'ABBRUCH bei Cancel, nil
|
||
;; wenn der Dialog gar nicht erst gezeigt werden konnte/durfte.
|
||
;; "Zurueck" hat an dieser allerersten Frage der ganzen Anlage nichts, wohin es
|
||
;; zurueckspringen koennte - wird daher lokal aufgeloest: der Dialog wird
|
||
;; einfach erneut gezeigt (kein Sonderfall fuer den Aufrufer noetig).
|
||
(defun vfc-dialog-typ-waehlen ( / dcl-pfad dat gtyp ergebnis fertig)
|
||
(if (and (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
|
||
(= *ssg-lang* "de_DE")
|
||
(equal (mapcar 'car *vf-typ-registry*) '("standard" "etage" "linienzug")))
|
||
(progn
|
||
(setq fertig nil)
|
||
(while (not fertig)
|
||
(setq fertig t)
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vfc_typ" dat))
|
||
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) (setq ergebnis nil))
|
||
(progn
|
||
(set_tile "typ_standard" "1")
|
||
(action_tile "accept"
|
||
"(setq gtyp (cond ((= (get_tile \"typ_etage\") \"1\") \"etage\")
|
||
((= (get_tile \"typ_linienzug\") \"1\") \"linienzug\")
|
||
(t \"standard\")))
|
||
(done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(action_tile "back" "(done_dialog 2)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(cond
|
||
((= ergebnis 1) (setq ergebnis gtyp))
|
||
((= ergebnis 2) (setq fertig nil)) ;; Zurueck: Dialog erneut zeigen
|
||
(t (setq ergebnis 'ABBRUCH))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
ergebnis
|
||
)
|
||
nil
|
||
)
|
||
)
|
||
|
||
;; Eingabemodus (3D-Linie / Werte manuell) per Dialog waehlen - ersetzt die
|
||
;; fruehere getstring-Konsolenabfrage in vf-dialog-ablauf. Gleiches Muster/
|
||
;; gleiche Einschraenkung wie vfc-dialog-typ-waehlen: nur bei aktiver GUI und
|
||
;; Deutsch, sonst nil (Aufrufer faellt dann auf die alte Konsolen-Abfrage
|
||
;; zurueck). Keine "Zurueck"-Taste noetig (direkt nach der Typ-Wahl, die
|
||
;; selbst schon ein "Zurueck" hat). Rueckgabe: "1" (3D-Linie), "2" (Werte)
|
||
;; oder 'ABBRUCH.
|
||
(defun vfc-dialog-eingabemodus-waehlen ( / dcl-pfad dat gmodus ergebnis)
|
||
(if (and (or (not (car (atoms-family 1 '("SSG-GUI-P")))) (ssg-gui-p))
|
||
(= *ssg-lang* "de_DE"))
|
||
(progn
|
||
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
|
||
(setq dat (load_dialog dcl-pfad))
|
||
(if (not (new_dialog "vfc_eingabemodus" dat))
|
||
(progn (if (and dat (>= dat 0)) (unload_dialog dat)) nil)
|
||
(progn
|
||
(set_tile "modus_3dlinie" "1")
|
||
(action_tile "accept"
|
||
"(setq gmodus (if (= (get_tile \"modus_werte\") \"1\") \"2\" \"1\"))
|
||
(done_dialog 1)")
|
||
(action_tile "cancel" "(done_dialog 0)")
|
||
(setq ergebnis (start_dialog))
|
||
(unload_dialog dat)
|
||
(if (= ergebnis 1) gmodus 'ABBRUCH)
|
||
)
|
||
)
|
||
)
|
||
nil
|
||
)
|
||
)
|
||
|
||
;; ============================================================
|
||
;; TEIL 12: DISPATCHER c:VarioFoerderer
|
||
;; ============================================================
|
||
;; Erzwungener QC-Modus (Linienzug-Modus 4/5, siehe *vf-vorauswahl-linienzug-
|
||
;; modus* oben/c:QcLinieMitGf*): "4"/"5" waehrend des naechsten
|
||
;; vf-linienzug-modus-Laufs, sonst nil. Von vf-linienzug-modus (vf_linienzug.
|
||
;; lsp, spaeter geladen) gelesen/geleert - globale Vorab-Deklaration hier,
|
||
;; damit sie unabhaengig von der Lade-Reihenfolge existiert.
|
||
(if (not (boundp '*vfl-forciere-qc-modus*)) (setq *vfl-forciere-qc-modus* nil))
|
||
(defun c:VarioFoerderer ( / typ-eintr anlage-typ berechne-fn einfuege-fn
|
||
idx wahl vf-nummer dlg-typ zurueck-zu-typ)
|
||
|
||
(princ "\n=========================================")
|
||
(princ (ssg-text "vfc-banner-titel"))
|
||
(princ "\n=========================================")
|
||
|
||
;; 1. Typ aus Registry waehlen
|
||
(if (null *vf-typ-registry*)
|
||
(progn
|
||
(alert (ssg-text "vfc-alert-keine-typen"))
|
||
(exit)
|
||
)
|
||
)
|
||
|
||
;; Aeussere Schleife nur wegen "Zurueck" bei der Linienzug-Modus-Frage
|
||
;; (springt zurueck zur Anlagen-Typ-Frage) - fuer Standard/Etage bleibt
|
||
;; zurueck-zu-typ immer nil, die Schleife laeuft dann genau einmal.
|
||
(setq zurueck-zu-typ t)
|
||
(while zurueck-zu-typ
|
||
(setq zurueck-zu-typ nil)
|
||
(if (and *vf-vorauswahl-typ* (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
|
||
(progn
|
||
(setq typ-eintr (assoc *vf-vorauswahl-typ* *vf-typ-registry*))
|
||
(princ (ssg-textf "vfc-typ-vorgewaehlt" (list *vf-vorauswahl-typ*)))
|
||
(setq *vf-vorauswahl-typ* nil)
|
||
)
|
||
(progn
|
||
(setq *vf-vorauswahl-typ* nil)
|
||
(setq dlg-typ (vfc-dialog-typ-waehlen))
|
||
(cond
|
||
((eq dlg-typ 'ABBRUCH) (exit))
|
||
(dlg-typ (setq typ-eintr (assoc dlg-typ *vf-typ-registry*)))
|
||
(t
|
||
;; Dialog nicht verfuegbar/nicht erlaubt (GUI aus, andere Sprache,
|
||
;; abweichende Registry) - alte Konsolen-Liste unveraendert.
|
||
(princ (ssg-text "vfc-anlagen-typ-header"))
|
||
(setq idx 1)
|
||
(foreach eintr *vf-typ-registry*
|
||
(princ (ssg-textf "vfc-typ-option" (list idx (nth 3 eintr))))
|
||
(setq idx (1+ idx))
|
||
)
|
||
(setq wahl (getint (ssg-textf "vfc-prompt-wahl-1-n"
|
||
(list (length *vf-typ-registry*)))))
|
||
(if (or (null wahl) (< wahl 1) (> wahl (length *vf-typ-registry*)))
|
||
(setq wahl 1))
|
||
(setq typ-eintr (nth (1- wahl) *vf-typ-registry*))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(setq anlage-typ (nth 0 typ-eintr))
|
||
(setq berechne-fn (nth 1 typ-eintr))
|
||
(setq einfuege-fn (nth 2 typ-eintr))
|
||
(princ (ssg-textf "vfc-typ-gewaehlt" (list anlage-typ)))
|
||
|
||
;; Sonderfall "linienzug": eigener Befehlsablauf (interaktive Mehrsegment-
|
||
;; Kette mit gemischten GF/VF-Segmenten), passt nicht in das berechne-fn/
|
||
;; einfuege-fn-Schema fuer ein einzelnes durchgehendes Segment - siehe
|
||
;; vf_linienzug.lsp. Dispatcht hier direkt und beendet den Standard-Ablauf.
|
||
;; Jeder Aufrufer (Menue-Wrapper c:LinienzugVarioFoerderer*/c:QcLinieMitGf*)
|
||
;; setzt *vf-vorauswahl-linienzug-modus* VOR dem Aufruf - der frueher
|
||
;; hier gefuehrte Modus-Dialog/Konsolen-Fallback ist dadurch entfallen.
|
||
(if (= anlage-typ "linienzug")
|
||
(progn
|
||
(setq wahl *vf-vorauswahl-linienzug-modus*
|
||
*vf-vorauswahl-linienzug-modus* nil)
|
||
(if (not zurueck-zu-typ)
|
||
(progn
|
||
;; Konsolen-Nummer -> interne Funktion:
|
||
;; 2 = fertiger Ziel-Hoehe-Modus (intern vf-linienzug-modus2)
|
||
;; 3 = alter Vorwaerts-Nachbau (intern vf-linienzug-modus3, wird umgebaut)
|
||
;; 1/Default = frische manuelle Eingabe (Journal vorher zuruecksetzen). Ein
|
||
;; abgebrochener Bau bleibt als VF_n-Block stehen und wird per Doppelklick
|
||
;; fortgesetzt/editiert (vfl-edit-ent), kein separater Menuepunkt noetig.
|
||
;; Journal-Reset gilt fuer JEDEN frischen Bau, nicht nur Modus 1: Modus 2
|
||
;; schreibt sein Journal ebenfalls als XDATA (Marker "linienzug2"), erbte
|
||
;; ohne Reset aber die Eintraege des Vorlaufs als Praefix - ein spaeterer
|
||
;; Doppelklick spielte dann fremde Eingaben vor. Die Edit-/Konvertier-Pfade
|
||
;; laufen nie hier durch (sie setzen ihre Queue selbst), darum ist das
|
||
;; Hochziehen ein reiner Bugfix. Setzt zugleich *vfl-seg-glied-letzte*
|
||
;; zurueck, das sonst vom Vorlauf stehenbleibt.
|
||
(vfl-journal-reset)
|
||
(setq *vfl-forciere-qc-modus* (cond ((= wahl 4) "4") ((= wahl 5) "5") (t nil)))
|
||
(cond ((= wahl 2) (vf-linienzug-modus2))
|
||
((= wahl 3) (vf-linienzug-modus3))
|
||
(t (vf-linienzug-modus)))
|
||
(exit)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; 2. VF-Nummer automatisch ermitteln
|
||
(setq vf-nummer (vf-next-number))
|
||
(princ (ssg-textf "vfc-naechste-vf-nummer" (list (itoa vf-nummer))))
|
||
|
||
;; 2b. Standard- ODER Etage-Typ -> DCL-Dialog (dcl/variofoerderer.dcl;
|
||
;; Standard: vfs-standard-dialog-ablauf in vf_standard.lsp, Etage:
|
||
;; vfe-etage-dialog-ablauf in vf_etage.lsp - beide duenne Wrapper um
|
||
;; vf-dialog-ablauf). Die Eingabemodus-Frage (3D-Linie vs. Werte) stellt
|
||
;; vf-dialog-ablauf selbst, VOR dem Basis-Dialog - bei 3D-Linie gehen
|
||
;; deltaL/deltaH/Richtung/Einfuegehoehe als Prefill in denselben
|
||
;; Basis-Dialog ein, den auch die Werteingabe nutzt (siehe dortiger
|
||
;; Kopfkommentar). Damit entfaellt der fruehere rein interaktive
|
||
;; Konsolen-Ablauf (Schritte 3-11, vf-eingabe-abfragen) komplett - er lief
|
||
;; bei 3D-Linie an der GUI vorbei und fragte Seite/Fahrtrichtung/Verteilung
|
||
;; erneut auf der Kommandozeile ab, obwohl der Dialog dieselben Felder
|
||
;; laengst per GUI anbietet.
|
||
(if (member anlage-typ '("standard" "etage"))
|
||
(progn
|
||
(if (= anlage-typ "etage")
|
||
(vfe-etage-dialog-ablauf vf-nummer)
|
||
(vfs-standard-dialog-ablauf vf-nummer))
|
||
(exit)
|
||
)
|
||
)
|
||
nil
|
||
)
|
||
|
||
;; ============================================================
|
||
;; START & ALIASES
|
||
;; ============================================================
|
||
(defun c:Foerderanlage () (c:VarioFoerderer))
|
||
|
||
;; Menue-Wrapper: jeder feste Endpunkt der VarioFoerderer-Erzeugung ist
|
||
;; direkt aufrufbar (Typ + Eingabemodus vorbelegt, keine Rueckfrage).
|
||
;; Eingabemodus-Vorauswahl: "2" = Werte manuell (DCL-Dialog),
|
||
;; "1" = aus 3D-Linie (Linie picken).
|
||
|
||
;; --- Standard (AS/ES 90 Grad) ---
|
||
(defun c:StandardVarioFoerderer () ; Werte manuell (DCL)
|
||
(setq *vf-vorauswahl-typ* "standard"
|
||
*vf-vorauswahl-eingabemodus* "2")
|
||
(c:VarioFoerderer)
|
||
)
|
||
(defun c:StandardVarioFoerderer3D () ; aus 3D-Linie
|
||
(setq *vf-vorauswahl-typ* "standard"
|
||
*vf-vorauswahl-eingabemodus* "1")
|
||
(c:VarioFoerderer)
|
||
)
|
||
|
||
;; --- Etage (AS/ES 30 Grad, uebereinander) ---
|
||
(defun c:EtageVarioFoerderer () ; Werte manuell (DCL)
|
||
(setq *vf-vorauswahl-typ* "etage"
|
||
*vf-vorauswahl-eingabemodus* "2")
|
||
(c:VarioFoerderer)
|
||
)
|
||
(defun c:EtageVarioFoerderer3D () ; aus 3D-Linie
|
||
(setq *vf-vorauswahl-typ* "etage"
|
||
*vf-vorauswahl-eingabemodus* "1")
|
||
(c:VarioFoerderer)
|
||
)
|
||
|
||
;; --- Linienzug/Streckengruppe (Modus 1/2/3, Typ+Modus vorbelegt) ---
|
||
(defun c:LinienzugVarioFoerdererManuell ()
|
||
(setq *vf-vorauswahl-typ* "linienzug"
|
||
*vf-vorauswahl-linienzug-modus* 1)
|
||
(c:VarioFoerderer)
|
||
)
|
||
(defun c:LinienzugVarioFoerdererZielhoehe ()
|
||
(setq *vf-vorauswahl-typ* "linienzug"
|
||
*vf-vorauswahl-linienzug-modus* 2)
|
||
(c:VarioFoerderer)
|
||
)
|
||
(defun c:LinienzugVarioFoerdererStueckweise ()
|
||
(setq *vf-vorauswahl-typ* "linienzug"
|
||
*vf-vorauswahl-linienzug-modus* 3)
|
||
(c:VarioFoerderer)
|
||
)
|
||
|
||
;; --- QC-Linie (Linienzug-Modus 4/5, Typ+Modus vorbelegt) ---
|
||
;; Menue: ILS -> Gefaellestrecke (gehoeren inhaltlich dorthin, technisch
|
||
;; weiterhin ueber den Linienzug-Ablauf/*vfl-forciere-qc-modus* gebaut).
|
||
(defun c:QcLinieMitGf ()
|
||
(setq *vf-vorauswahl-typ* "linienzug"
|
||
*vf-vorauswahl-linienzug-modus* 4)
|
||
(c:VarioFoerderer)
|
||
)
|
||
(defun c:QcLinieMitGfUForm ()
|
||
(setq *vf-vorauswahl-typ* "linienzug"
|
||
*vf-vorauswahl-linienzug-modus* 5)
|
||
(c:VarioFoerderer)
|
||
)
|
||
|
||
;; ssg-ensure-Flags fuer beide Wrapper-Dateien setzen,
|
||
;; damit ein zweiter Ladeaufruf uebersprungen wird.
|
||
(setq *ssg-VarioFoerderer-loaded* t)
|
||
(setq *ssg-EtageVarioFoerderer-loaded* t)
|
||
|
||
(princ)
|