Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
806c14b877622e1c5dc45a3bf1130b46dcb5b50d
dxfmakros/Lisp/vf_core.lsp
T
s.ayadi 29b7bf1a10 [FIX] Weltposition verpackter Separator_SP-Symbole bei gekippten Ketten 
ssg-collect-nested-inserts-rel/csv:sep-proxies-erzeugen nahmen bislang eine
reine Z-Drehung ohne OCS-/Extrusionsrichtung an. Fuer die um den Gefaelle-/
Neigungswinkel gekippte Staustrecke/Separator-Kette (Gefaellestrecke.lsp,
vf_standard.lsp) ist das falsch: die eingebettete Separator_SP-Weltposition
blieb dadurch unabhaengig von der gewaehlten Fahrtrichtung eingefroren.

Fix generalisiert die Rotationskomposition auf volle 3x3-Matrizen (Arbitrary
Axis Algorithm fuer die Extrusion, neue mat3-*-Helfer in ssg_core.lsp statt
vf_core.lsp, da ssg_core immer vor jedem Feature-Modul geladen ist). Fuer
flache Elemente (Extrusion (0 0 1)) reduziert sich das exakt auf die alte
reine Z-Drehung - kein Verhaltensunterschied dort.

Verifiziert per Python/ezdxf-Nachbau des neuen Algorithmus gegen die drei
real gebauten Testzeichnungen (data/gf.dxf, data/gf_north.dxf,
data/gf_south.dxf): liefert jetzt fuer alle drei Fahrtrichtungen exakt die
unabhaengig berechnete Grundwahrheit statt eines eingefrorenen Werts.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-04 12:42:10 +02:00

1379 lines
62 KiB
Common Lisp
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;; ============================================================
;; 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))
;; 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))
(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))))
;; 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-Fragen
;; (princ + getstring, de/en ueber ssg-text). Gemeinsam genutzt von
;; Gefaellestrecke.lsp UND vf_linienzug.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"))
)
(progn
(princ (ssg-text headerkey))
(princ (ssg-text "vf-winkel-90"))
(princ (ssg-text "vf-winkel-30"))
(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))))
(defun vf-set-es-masse (winkel seite / m)
(setq m (vf-element-masse (strcat "ES_Element_" winkel "_" seite)))
(if m (setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m))))
;; ============================================================
;; 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)
(defun vf-eingabe-abfragen ( / eingabe-modus line-points startpunkt endpunkt differenz
deltaL deltaH deltaX deltaY richtung antwort hz-winkel)
(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")))
(cond
((= antwort "1") (setq eingabe-modus "Linie"))
((= antwort "2") (setq eingabe-modus "Wert"))
(t (setq eingabe-modus "Linie") (princ (ssg-text "vfc-modus-3dlinie-fallback")))
)
(if (= eingabe-modus "Linie")
(progn
(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")) (exit))
)
(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")))
)
)
(progn
(princ (ssg-text "vfc-modus-werteingabe-header"))
(setq deltaL (getreal (ssg-textf "vfc-prompt-delta-l" (list (chr 916)))))
(if (null deltaL) (setq deltaL 15000))
(setq deltaH (getreal (ssg-textf "vfc-prompt-delta-h" (list (chr 916)))))
(if (null deltaH) (setq deltaH 3000))
;; Foerderrichtung bleibt eine einfache Auf/Ab-Frage - die horizontale
;; Zwischenstrecke ist geometrisch NUR bei "Ab" ueberhaupt erreichbar
;; (die festen 3-Grad-Elemente wirken immer absenkend) und wird daher
;; erst SPAETER, nach Bibliotheks-Init, als Zusatzoption in der
;; Winkel-Auswahl angeboten (siehe c:VarioFoerderer) - einheitlich fuer
;; Werteingabe UND 3D-Linie.
(princ (ssg-text "vfc-foerderrichtung-menu"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "2") (setq richtung "Ab") (setq richtung "Auf"))
(setq startpunkt (getpoint (ssg-text "vfc-prompt-startpunkt-aus")))
(if (null startpunkt) (setq startpunkt '(0 0 0)))
;; Horizontale Fahrtrichtung waehlen (analog Gefaellestrecke Modus 1)
(princ (ssg-text "vfc-fahrtrichtung-header"))
(princ (ssg-textf "vfc-fahrtrichtung-0" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-90" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-180" (list grad-zeichen)))
(princ (ssg-textf "vfc-fahrtrichtung-270" (list grad-zeichen)))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(cond
((= antwort "2") (setq hz-winkel 90.0))
((= antwort "3") (setq hz-winkel 180.0))
((= antwort "4") (setq hz-winkel 270.0))
(t (setq hz-winkel 0.0))
)
(princ (ssg-textf "vfc-fahrtrichtung-ergebnis" (list (rtos hz-winkel 2 1) grad-zeichen)))
)
)
(list deltaL deltaH richtung startpunkt hz-winkel eingabe-modus)
)
;; ============================================================
;; 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)
))
)
;; Ermittelt den "letzten Entity" VOR einer neuen Einfuegung, so dass
;; nachfolgende Attribut-Entities/SEQEND eines vorherigen INSERT (z.B. eines
;; vorangegangenen VF_N-Blocks) nicht versehentlich in die naechste
;; vf-block-erstellen-Sammlung hineinfallen. Muss von JEDEM Aufrufer von
;; vf-block-erstellen anstelle eines nackten (entlast) verwendet werden.
(defun vf-lastent-ohne-attribute ( / ent)
(setq ent (entlast))
(if (and ent
(= (cdr (assoc 0 (entget ent))) "INSERT")
(= (cdr (assoc 66 (entget ent))) 1))
(progn
(setq ent (entnext ent))
(while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND"))
(setq ent (entnext ent))
)
)
)
ent
)
;; 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-bname vf-ss vf-e vf-insert montagehoehe-m attdef-ypos 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
(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)
;; Unsichtbare ATTDEFs am Startpunkt erzeugen (gemeinsames Strecken-Schema;
;; VarioFoerderer ist immer TYP "Streckengruppe" -> voller Attributsatz).
(setq attdef-ypos (cadr startpunkt))
(foreach def (ssg-strecke-attrib-defs "Streckengruppe")
(entmake (list
'(0 . "ATTDEF")
'(8 . "0")
'(67 . 0)
(cons 10 (list (car startpunkt) attdef-ypos (caddr startpunkt)))
(cons 40 *vfk-attdef-texthoehe*)
(cons 1 (cadr def))
(cons 3 (car def))
(cons 2 (car def))
'(70 . 1)
))
(setq attdef-ypos (- attdef-ypos *vfk-attdef-zeilenabstand*))
)
;; Alle neuen Entities seit lastEnt sammeln
(setq vf-ss (ssadd))
(if lastEnt
(setq vf-e (entnext lastEnt))
(setq vf-e (entnext))
)
(while vf-e
(ssadd vf-e vf-ss)
(setq vf-e (entnext vf-e))
)
;; Block erstellen, einfuegen, Attribute setzen
(setq vf-bname (strcat "VF_" (itoa vf-nummer)))
(if (> (sslength vf-ss) 0)
(progn
;; Block definieren und einfuegen mit garantiert weltparallelem BKS.
;; startpunkt ist ein Welt-Punkt; ssg-block-wrap-welt setzt das BKS
;; temporaer auf Welt (verhindert den 31.95mm-Z-Versatz bei
;; abweichendem BKS) und stellt es danach wieder her.
(setq vf-insert (ssg-block-wrap-welt vf-bname startpunkt vf-ss))
;; Ziel-Layer der Baugruppe aus cfg/layer.cfg (ohne Eintrag bleibt die
;; Referenz auf dem aktuellen Layer, wie vor der Umstellung).
(ssg-layer-setzen vf-insert "variofoerderer")
(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)))
(ssg-attrib-set-on vf-insert
(list
(cons "Bezeichnung" vf-bname)
;; 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")
(ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_R_60" "2")))
(ssg-attrib-set-on vf-insert (list (cons "GF_Bogen_L_60" "2")))
)
)
;; Aufsteigende, eindeutige ID vergeben (wie beim Kreisel), falls verfuegbar.
(if (car (atoms-family 1 '("SSG-ID-GENERATE")))
(ssg-id-generate vf-insert))
;; Dimension (2D/3D) merken -> Doppelklick-Edit erkennt sie automatisch.
(if (car (atoms-family 1 '("SSG-DIM-XDATA-SCHREIBEN")))
(ssg-dim-xdata-schreiben vf-insert (ssg-ils-dim-aktuell)))
(princ (ssg-textf "vfc-block-erstellt-eingefuegt" (list vf-bname)))
vf-insert
)
(progn (princ (ssg-text "vfc-fehler-keine-entities")) nil)
)
)
;; ============================================================
;; 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"))
(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 (vf-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)
)
;; Neuanlage (Menue/Konsole -> Dialog) fuer einen Registry-Typ: Startpunkt
;; (X/Y) picken, Basis-Dialog, dann vf-dialog-berechnen-einfuegen.
(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)
(setq startpunkt-xy (getpoint (ssg-text "vfc-prompt-startpunkt-aus")))
(if (null startpunkt-xy) (setq startpunkt-xy '(0 0 0)))
(setq eingabe (vfs-dialog-eingabe-basis nil))
(if (null eingabe)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(vf-basis-eingabe-entpacken eingabe)
(setq startpunkt (list (car startpunkt-xy) (cadr startpunkt-xy) 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 v26.0 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 12: DISPATCHER c:VarioFoerderer
;; ============================================================
(defun c:VarioFoerderer ( / typ-eintr anlage-typ berechne-fn einfuege-fn
eingabe deltaL deltaH richtung startpunkt seite hz
eingabe-modus ergebnis ergebnis-liste gueltige-winkel
horizontal-info
best-winkel L_GF L_GF1 L_GF2 L_VF
idx eintrag wahl antwort verteilung-modus
n-scanner vf-nummer hoehe-von hoehe-bis lastEnt
staustrecke-basis vf-insert)
(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)
)
)
(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)
(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.
(if (= anlage-typ "linienzug")
(progn
(princ (ssg-text "vfc-linienzug-modus-header"))
(princ (ssg-text "vfc-linienzug-modus-1"))
(princ (ssg-text "vfc-linienzug-modus-2"))
(princ (ssg-text "vfc-linienzug-modus-3"))
(setq wahl (getint (ssg-text "prompt-wahl-1-2-3")))
;; 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. 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)
(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 + Werteingabe -> DCL-Dialog
;; (dcl/variofoerderer.dcl; Standard: vfs-standard-dialog-ablauf in
;; vf_standard.lsp, Etage: vfe-etage-dialog-ablauf in vf_etage.lsp - beide
;; nutzen dieselben Dialoge vfs-dialog-eingabe-basis/-winkel-verteilung).
;; 3D-Linie-Eingabe und der Typ Linienzug bleiben unveraendert interaktiv
;; (fallen unten in den Konsolen-Ablauf, der die Eingabemodus-Frage erneut
;; stellt - siehe vf-eingabe-abfragen).
(if (member anlage-typ '("standard" "etage"))
(progn
(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 (= antwort "2")
(progn
(if (= anlage-typ "etage")
(vfe-etage-dialog-ablauf vf-nummer)
(vfs-standard-dialog-ablauf vf-nummer))
(exit)
)
)
)
)
;; 3. Gemeinsame Eingabe (deltaL, deltaH, richtung, startpunkt) - richtung
;; steht bei beiden Eingabemodi (Werteingabe UND 3D-Linie) bereits fest.
(setq eingabe (vf-eingabe-abfragen))
(setq deltaL (nth 0 eingabe)
deltaH (nth 1 eingabe)
richtung (nth 2 eingabe)
startpunkt (nth 3 eingabe)
hz (nth 4 eingabe)
eingabe-modus (nth 5 eingabe))
;; 4. Seite-Auswahl (vor Berechnung, weil Etage-Typ sie fuer Geometrie braucht)
(princ (ssg-text "vfc-seite-header"))
(princ (ssg-text "vfc-seite-rechts"))
(princ (ssg-text "vfc-seite-links"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2") (setq seite "links") (setq seite "rechts"))
(princ (ssg-textf "vfc-seite-gewaehlt" (list seite)))
;; 5. Typ-spezifische Berechnung (init + Winkelsuche)
(setq ergebnis (apply berechne-fn (list deltaL deltaH richtung seite)))
(setq ergebnis-liste (cadddr ergebnis))
;; 5b. Horizontale Zwischenstrecke als Zusatzoption: geometrisch NUR bei
;; "Ab" ueberhaupt erreichbar (die festen 3-Grad-Elemente wirken immer
;; absenkend) - "Auf" wird deshalb gar nicht erst geprueft. Gilt einheitlich
;; fuer Werteingabe UND 3D-Linie, da richtung hier in jedem Fall feststeht.
;; Bibliothek ist durch den berechne-fn-Aufruf oben bereits initialisiert.
(if (and (= anlage-typ "standard") (= richtung "Ab"))
(progn
(setq horizontal-info (berechne-horizontale-mitte deltaL deltaH "Ab"))
(if (and horizontal-info (caddr horizontal-info))
(progn
(setq ergebnis-liste
(append ergebnis-liste
(list (list 0 (car horizontal-info) (cadr horizontal-info) T))))
(princ (ssg-textf "vfc-hinweis-horizontal-moeglich" (list (chr 176) (chr 916))))
)
(setq horizontal-info nil)
)
)
)
;; Konfiguration (nach ssg_core-Init verfuegbar).
(setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
;; 7. Gueltige Winkel ermitteln
(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)
(progn
(alert (ssg-textf "vfc-alert-kein-winkel"
(list (chr 916) (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(exit)
)
)
;; 8. Winkelauswahl (automatisch oder interaktiv)
;; Sentinel-Winkel 0 = horizontale Zwischenstrecke (Schritt 6/11 bei 0
;; Grad, Boegen fest auf_3/ab_3) - siehe berechne-horizontale-mitte.
(if (= (length gueltige-winkel) 1)
(progn
(setq best-winkel (car gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(if (= best-winkel 0)
(princ (ssg-text "vfc-einzige-variante-horizontal"))
(princ (ssg-textf "vfc-einziger-winkel" (list (itoa best-winkel) (chr 176))))
)
)
(progn
(princ (ssg-text "vfc-mehrere-winkel-header"))
(setq idx 1)
(foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste))
(if (= w 0)
(princ (ssg-textf "vfc-winkel-option-horizontal"
(list idx (chr 176)
(rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
(princ (ssg-textf "vfc-winkel-option"
(list idx (itoa w) (chr 176)
(rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
)
(setq idx (1+ idx))
)
(setq wahl (getint (ssg-textf "vfc-prompt-winkel-waehlen"
(list (length gueltige-winkel)))))
(if (or (null wahl) (< wahl 1) (> wahl (length gueltige-winkel)))
(setq wahl 1))
(setq best-winkel (nth (1- wahl) gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
)
)
(princ "\n\n=========================================")
(if (= best-winkel 0)
(princ (ssg-textf "vfc-zus-horizontal"
(list (rtos L_GF 2 2) (rtos L_VF 2 2))))
(princ (ssg-textf "vfc-zus-winkel"
(list (itoa best-winkel) (chr 176) (rtos L_GF 2 2) (rtos L_VF 2 2))))
)
(princ "\n=========================================")
;; 9. L_GF Verteilung
(princ (ssg-text "vfc-gf-verteilung-header"))
(princ (ssg-text "vfc-gf-verteilung-1"))
(princ (ssg-text "vfc-gf-verteilung-2"))
(princ (ssg-text "vfc-gf-verteilung-3"))
(princ (ssg-text "vfc-gf-verteilung-4"))
(setq verteilung-modus (getstring (ssg-text "prompt-wahl-1-2-3-4")))
(if (= verteilung-modus "") (setq verteilung-modus "1"))
(cond
((= verteilung-modus "1")
(setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
((= verteilung-modus "2")
(setq L_GF1 (float staustrecke-basis))
(setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "3")
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "4")
(setq L_GF1 (getreal (ssg-textf "vfc-prompt-lgf1-vorne"
(list (rtos (/ L_GF 2.0) 2 2)))))
(if (null L_GF1) (setq L_GF1 (/ L_GF 2.0)))
(setq L_GF2 (max 0.0 (- L_GF L_GF1)))
(princ (ssg-textf "vfc-lgf2-hinten" (list (rtos L_GF2 2 2)))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(princ (ssg-textf "vfc-zus-lgf" (list (rtos L_GF1 2 2) (rtos L_GF2 2 2))))
;; Scanner-Anzahl wird nicht mehr abgefragt (Attribut ANZAHL_SCANNER bleibt 0).
(setq n-scanner 0)
;; 11. Bestaetigung
(princ (ssg-text "vfc-einfuegen-frage"))
(princ (ssg-text "vfc-einfuegen-optionen"))
(setq antwort (getstring (ssg-text "vfc-prompt-wahl-1-2-ohne-default")))
(if (= antwort "1")
(progn
;; Hoehenangaben fuer Attribute und Beschriftung
(setq hoehe-von (caddr startpunkt))
(setq hoehe-bis (cond
((= richtung "Auf") (+ hoehe-von deltaH))
((= richtung "Ab") (- hoehe-von deltaH))
(t hoehe-von)))
;; lastEnt VOR der Einfuegung merken
(setq lastEnt (vf-lastent-ohne-attribute))
;; Typ-spezifische Einfuegung
(apply einfuege-fn
(list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz))
;; Gemeinsame VF_*-Block-Erstellung
;; Geruest fuer Einzelmodul/Geruestoption sind in diesem interaktiven
;; Konsolen-Ablauf (Etage/Linienzug) nicht abfragbar - bleiben auf
;; Schema-Default (analog Kreisel: nur ueber Dialog editierbar).
(setq vf-insert
(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
"0" "Schoenenberger Geruest"))
;; Standard- UND Etage-Bloecke aus dem interaktiven Konsolen-Ablauf mit der
;; SSG_VF_EDIT-XDATA markieren - sie sind (wie die Dialog-Variante) aus
;; Attributen + hz verlustfrei rekonstruierbar, also per Doppelklick
;; (c:VARIOFOERDERER_EDIT) editierbar. Linienzug bleibt unmarkiert.
(if (and vf-insert (member anlage-typ '("standard" "etage")))
(vf-edit-xdata-schreiben vf-insert anlage-typ hz))
(princ "\n=========================================")
)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
)
nil
)
;; ============================================================
;; START & ALIASES
;; ============================================================
(defun c:Foerderanlage () (c:VarioFoerderer))
(defun c:EtageVarioFoerderer ()
(setq *vf-vorauswahl-typ* "etage")
(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 "\n>>> Befehle: VarioFoerderer, Foerderanlage, EtageVarioFoerderer")
(princ "\n Typen:")
(setq *vf-typ-idx* 1)
(foreach eintr *vf-typ-registry*
(princ (strcat "\n " (itoa *vf-typ-idx*) ". " (car eintr) " - " (nth 3 eintr)))
(setq *vf-typ-idx* (1+ *vf-typ-idx*))
)
(if block-pfad (princ (strcat "\n Block-Pfad: " block-pfad)))
(princ "\n=========================================")
(princ)
Reference in New Issue View Git Blame Copy Permalink