mistangl/dxfmakros
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
e67f7cc1aa20065fba7cd45bce72e2ca84d57d22
dxfmakros/Lisp/vf_standard.lsp
T
Samer AyadiandClaude Opus 5.5 e67f7cc1aa export: Separator-Typ VF/GF aus der Ketten-Einheit statt Bau-XDATA 
Der Typ (Merkmal "Typ") jeder Separator-Zeile kommt jetzt an EINER Stelle
aus der Einheiten-Schneidung csv:kette-einheiten (neu: csv:kette-sep-typen,
eingetragen in csv:ketten-verarbeiten) - dieselbe Quelle wie die
Einheiten-Boundingbox. VF = Separator direkt vor der Umlenkstation bzw.
zwischen Umlenk- und Motorstation, sonst GF.

Die bauzeitige XDATA SSG_SEP_TYP (ssg-sep-typ-xdata-schreiben/-lesen,
15 Einfuegestellen) entfaellt. Sie war teils falsch: der Separator vor dem
ES hinter einer Motorstation bekam "VF", und ein sep_nach-Separator einer
GF, den die folgende VF-Einheit als Einlauf nutzt, blieb "GF"
(HundM05: Sep1/5/7/9/11 und Sep2).

Unit-Tests csv:kette-sep-typen in tests/test_unit.lsp.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-09-28 11:23:27 +02:00

1367 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_STANDARD - Standard VarioFoerderer (Typ: "standard")
;; Version: 26.0
;; Abhaengigkeit: vf_core.lsp muss zuerst geladen sein
;; Geometrie: AS/ES 90 Grad, horizontal versetzt
;; 11-Schritt-Einfuegung
;; ============================================================
;; Sicherstellen, dass vf_core.lsp geladen ist. Pfad zentral ueber ssg_core
;; (ssg-lisp-verzeichnis), mit Inline-Fallback falls ssg_core hier noch nicht
;; geladen ist (nur relevant beim isolierten Einzel-Laden dieser Datei).
(if (not (car (atoms-family 1 '("VF-TYP-REGISTRIEREN"))))
(progn
(setq *vf-std-core-pfad*
(if (car (atoms-family 1 '("SSG-LISP-VERZEICHNIS")))
(ssg-lisp-verzeichnis)
(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-std-core-pfad*
(load (strcat *vf-std-core-pfad* "/vf_core.lsp"))
(progn
(princ (ssg-text "vfs-warn-lisppfad"))
(exit)
)
)
)
)
;; ============================================================
;; TEIL 1: STANDARD-SPEZIFISCHE GLOBALE VARIABLEN
;; ============================================================
(setq aus-dx nil aus-dy nil aus-dz nil)
(setq ein-dx nil ein-dy nil ein-dz nil)
(setq separator-laenge nil umlenk-laenge nil motorstation-laenge nil)
(setq staustrecke-basis 1000)
(setq FESTE_HORIZONTAL 1600)
(setq bogen-auf '())
(setq bogen-ab '())
(setq *lib-initialized* nil)
(setq *bogen-cache-loaded* nil)
(setq *modul-cache* nil)
;; ============================================================
;; TEIL 2: BLOCK-DATEI-PRUEFUNG
;; ============================================================
;; Prueft ob alle benoetigten Block-Dateien vorhanden sind.
;; Gibt t zurueck wenn OK (oder Library-DXF vorhanden), nil wenn Einzeldateien fehlen.
(defun vf-check-required-blocks ( / lib-datei bogen-winkel required-blocks missing bname datei)
(setq lib-datei
(strcat (vl-string-translate "\\" "/" (getenv "DXFM_DATA"))
"/block_libraries/ils_library.dxf"))
(if (findfile lib-datei)
t ;; Library-Datei vorhanden: alle Bloecke darin verfuegbar
(progn
(setq bogen-winkel (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq required-blocks
(append
(list "AS_Element_90_links" "AS_Element_90_rechts"
"ES_Element_90_links" "ES_Element_90_rechts"
"Staustrecke_SP_1000_mm" "Staustrecke_Separator_SP_300_mm"
"Vario_Umlenkstation_500mm_links" "Vario_Umlenkstation_500mm_rechts"
"Vario_Motorstation_500mm_links" "Vario_Motorstation_500mm_rechts")
(mapcar (function (lambda (w) (strcat "Vario_Bogen_auf_" (itoa w) "_TEF_rechts"))) bogen-winkel)
(mapcar (function (lambda (w) (strcat "Vario_Bogen_ab_" (itoa w) "_TEF_rechts"))) bogen-winkel)
)
)
(setq missing '())
(foreach bname required-blocks
;; Existenz ueber den zentralen Resolver (flache Ablage + Dim-Suffix der
;; aktuellen Dimension + 3D-Fallback).
(if (not (ssg-ils-block-datei bname))
(setq missing (cons (ssg-ils-blockname bname) missing))
)
)
(if missing
(progn
(princ (ssg-textf "vfs-block-fehler-pfad" (list block-pfad)))
(princ (ssg-text "vfs-block-fehlende-header"))
(foreach f (reverse missing)
(princ (ssg-textf "vfs-block-fehlende-item" (list f)))
)
nil
)
t
)
)
)
)
;; ============================================================
;; TEIL 3: BIBLIOTHEK INITIALISIEREN
;; ============================================================
(defun init-bibliothek ( / temp-obj bogen-winkel ks-data ks-ein-pos ks-aus-pos
dx dy dz bogen-name as-blk es-blk m)
;; "bereits initialisiert" nur, wenn das Flag gesetzt UND die Bogen-Tabelle
;; tatsaechlich befuellt ist. Sonst (Stuck-State: Flag gesetzt, aber bogen-auf
;; leer - z.B. nach einer fehlgeschlagenen Extraktion) neu initialisieren.
(if (and *lib-initialized* bogen-auf bogen-ab
(tblsearch "BLOCK" (ssg-ils-blockname "AS_Element_90_links")))
(progn
(princ (ssg-text "vfs-lib-bereits-init"))
t
)
(if (not (vf-check-required-blocks))
nil
(progn
(setq *lib-initialized* nil)
(setq *ks-cache* nil)
(princ (ssg-text "vfs-lib-init-start"))
;; AS_90 Masse extrahieren (KS_EIN->KS_AUS als (dx dy dz) via vf-element-masse)
(princ (ssg-text "vfs-extrahiere-aus"))
(setq as-blk (ensure-block-loaded "AS_Element_90_links"))
(ensure-block-loaded "AS_Element_90_rechts")
(if (tblsearch "BLOCK" as-blk)
(progn
(setq m (vf-element-masse "AS_Element_90_links"))
(if m
(progn
(setq aus-dx (car m) aus-dy (cadr m) aus-dz (caddr m))
(princ (ssg-textf "vfs-as90-mass" (list (rtos aus-dx 2 0) (rtos aus-dz 2 0))))
)
(princ (ssg-text "vfs-fehler-ks-as90"))
)
)
(princ (ssg-text "vfs-fehler-block-as90"))
)
;; ES_90 Masse extrahieren
(princ (ssg-text "vfs-extrahiere-ein"))
(setq es-blk (ensure-block-loaded "ES_Element_90_links"))
(ensure-block-loaded "ES_Element_90_rechts")
(if (tblsearch "BLOCK" es-blk)
(progn
(setq m (vf-element-masse "ES_Element_90_links"))
(if m
(progn
(setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m))
(princ (ssg-textf "vfs-es90-mass" (list (rtos ein-dx 2 0) (rtos ein-dz 2 0))))
)
(princ (ssg-text "vfs-fehler-ks-es90"))
)
)
(princ (ssg-text "vfs-fehler-block-es90"))
)
;; Bogen-Masse extrahieren
(princ (ssg-text "vfs-extrahiere-bogen"))
(setq bogen-auf '())
(setq bogen-ab '())
(setq bogen-winkel (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(foreach w bogen-winkel
;; Aufwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa w) "_TEF_rechts"))
(if (tblsearch "BLOCK" (ensure-block-loaded bogen-name))
(progn
(setq m (vf-element-masse bogen-name))
(if m
(progn
(setq bogen-auf (cons (cons w m) bogen-auf))
(princ (ssg-textf "vfs-bogen-auf-ok" (list (itoa w) (rtos (car m) 2 0) (rtos (caddr m) 2 0))))
)
(princ (ssg-textf "vfs-bogen-auf-ks-fehlt" (list (itoa w))))
)
)
(princ (ssg-textf "vfs-bogen-auf-block-fehlt" (list (itoa w))))
)
;; Abwaertsbogen
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa w) "_TEF_rechts"))
(if (tblsearch "BLOCK" (ensure-block-loaded bogen-name))
(progn
(setq m (vf-element-masse bogen-name))
(if m
(progn
(setq bogen-ab (cons (cons w m) bogen-ab))
(princ (ssg-textf "vfs-bogen-ab-ok" (list (itoa w) (rtos (car m) 2 0) (rtos (caddr m) 2 0))))
)
(princ (ssg-textf "vfs-bogen-ab-ks-fehlt" (list (itoa w))))
)
)
(princ (ssg-textf "vfs-bogen-ab-block-fehlt" (list (itoa w))))
)
)
(setq bogen-auf (reverse bogen-auf))
(setq bogen-ab (reverse bogen-ab))
(setq *lib-initialized* t)
(princ (ssg-text "vfs-lib-init-erfolg"))
t
) ;; end progn (Initialisierung)
) ;; end (if not vf-check-required-blocks)
) ;; end outer (if and *lib-initialized*)
)
;; ============================================================
;; TEIL 3: BOGEN-MASSE
;; ============================================================
(defun get-bogen-mass (tabelle winkel)
(setq result nil)
(foreach item tabelle
(if (= (car item) winkel) (setq result (cdr item)))
)
(if (null result)
(princ (ssg-textf "vfs-fehler-winkel-tabelle" (list (itoa winkel))))
)
result
)
;; ============================================================
;; TEIL 4: WINKELBERECHNUNG
;; ============================================================
;; Laengen-/Hoehenbilanz (A/B) fuer EINEN Kandidatenwinkel des S-Bogens -
;; die Vektorzerlegung, die vf-winkel-solve danach nach L_GF/L_VF aufloest.
;; Ausgelagert aus berechne-alle-winkel (frueher inline dupliziert), damit
;; vfl-stufe3-winkel-horizontal (vf_linienzug.lsp - fixiert L_GF statt es zu
;; loesen) dieselbe Bilanz ohne Code-Duplikation nutzen kann.
;; mass1/mass2: (get-bogen-mass bogen-auf/-ab winkel), vom Aufrufer schon
;; richtungsabhaengig zugeordnet (Auf: mass1=auf, mass2=ab; Ab: umgekehrt).
;; entry-dx/entry-dz: Fussabdruck eines evtl. vorgeschalteten Uebergangsbogens
;; (schon-flach-Fall), sonst 0.0. Rueckgabe: (list A B), oder nil wenn
;; mass1/mass2 fehlen (Bogen bei diesem Winkel nicht verfuegbar).
(defun vf-winkel-AB (winkel richtung mass1 mass2 deltaL deltaH feste-hz
entry-dx entry-dz abs-dz-AUS abs-dz-EIN sin3 cos3 /
rad5 rad7 bogen-x1 bogen-z1 bogen-x2 bogen-z2 A B)
(if (or (null mass1) (null mass2))
nil
(progn
(setq rad5 (* *vfk-gefaelle-winkel* (/ pi 180.0)))
(setq rad7 (* (float (if (= richtung "Auf") (- *vfk-gefaelle-winkel* winkel) (+ winkel *vfk-gefaelle-winkel*)))
(/ pi 180.0)))
(setq bogen-x1 (+ (* (car mass1) (cos rad5)) (* (caddr mass1) (sin rad5))))
(setq bogen-z1 (+ (* (- (car mass1)) (sin rad5)) (* (caddr mass1) (cos rad5))))
(setq bogen-x2 (+ (* (car mass2) (cos rad7)) (* (caddr mass2) (sin rad7))))
(setq bogen-z2 (+ (* (- (car mass2)) (sin rad7)) (* (caddr mass2) (cos rad7))))
(setq A (- deltaL aus-dx ein-dx bogen-x1 bogen-x2
(* feste-hz cos3) entry-dx))
(if (= richtung "Auf")
(setq B (+ deltaH abs-dz-AUS abs-dz-EIN (abs entry-dz)
(- bogen-z1) (- bogen-z2)
(* feste-hz sin3)))
(setq B (+ (- deltaH abs-dz-AUS abs-dz-EIN (abs entry-dz)
(* feste-hz sin3))
bogen-z1 bogen-z2))
)
(list A B)
)
)
)
;; feste-hz: horizontales Budget der festen Elemente (Umlenk+Motor+Separatoren).
;; nil => Standardwert FESTE_HORIZONTAL (1600, Standard-VF mit 2 Separatoren).
;; Der Linienzug uebergibt 1300 (nur 1 Separator am Einlauf, siehe vf_linienzug).
;; schon-flach: T => der Frame kommt FLACH (0 Grad) an, statt schon auf der
;; 3-Grad-Basis zu stehen - der Aufrufer wird VOR dem eigentlichen VF-Koerper
;; noch einen Uebergangsbogen (flach->3 Grad, IMMER "ab", siehe vfl-nach-
;; 3grad) einfuegen, dessen Fussabdruck (entry-dx/entry-dz) hier - genau wie
;; aus-dx/aus-dz beim AS-Element - VORAB vom verfuegbaren Budget abgezogen
;; werden muss. Ohne das wurde diese Strecke stillschweigend verbraucht und
;; die Kette verfehlte den Zielpunkt (real beobachtet: schon-flach-Faelle im
;; Linienzug-Kettenende, bis dahin nur bei Stufe 2/berechne-horizontale-mitte
;; beruecksichtigt). Default nil (unveraendertes Verhalten fuer alle
;; Aufrufer, die immer von der 3-Grad-Basis starten).
(defun berechne-alle-winkel (deltaL deltaH richtung feste-hz schon-flach /
winkel-list ergebnis-liste A B cos3 sin3
ab-erg
abs-dz-AUS abs-dz-EIN L_GF L_VF cosα sinα
winkel-eff cosEff sinEff
winkel mass1 mass2 gueltig entry-mass entry-dx entry-dz
best-winkel best-L_GF best-L_VF)
(if (or (not *lib-initialized*) (null aus-dz) (null ein-dz))
(progn
(princ (ssg-text "vfs-fehler-lib-nicht-init"))
(exit)
)
)
(if (null feste-hz) (setq feste-hz FESTE_HORIZONTAL))
(setq entry-dx 0.0 entry-dz 0.0)
(if schon-flach
(progn
(setq entry-mass (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(setq entry-dx (car entry-mass) entry-dz (caddr entry-mass))))
(setq abs-dz-AUS (abs aus-dz) abs-dz-EIN (abs ein-dz))
(setq winkel-list (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq ergebnis-liste '())
(setq cos3 (cos (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0)))
sin3 (sin (* (ssg-cfg-or "vario" "gefaelle_winkel" 3) (/ pi 180.0))))
(princ "\n\n=========================================")
(princ (ssg-text "vfs-berechnung-header"))
(princ "\n=========================================")
(princ (ssg-textf "vfs-berechnung-parameter"
(list (rtos deltaL 2 2) (rtos deltaH 2 2) richtung)))
(foreach winkel winkel-list
(if (= richtung "Auf")
(progn
(setq mass1 (get-bogen-mass bogen-auf winkel))
(setq mass2 (get-bogen-mass bogen-ab winkel))
)
(progn
(setq mass1 (get-bogen-mass bogen-ab winkel))
(setq mass2 (get-bogen-mass bogen-auf winkel))
)
)
(setq ab-erg (vf-winkel-AB winkel richtung mass1 mass2 deltaL deltaH feste-hz
entry-dx entry-dz abs-dz-AUS abs-dz-EIN sin3 cos3))
(if (null ab-erg)
(setq ergebnis-liste (cons (list winkel nil nil nil) ergebnis-liste))
(progn
(setq A (car ab-erg) B (cadr ab-erg))
(setq cosα (cos (* winkel (/ pi 180.0)))
sinα (sin (* winkel (/ pi 180.0))))
(setq winkel-eff (if (= richtung "Auf") (- winkel *vfk-gefaelle-winkel*) (+ winkel *vfk-gefaelle-winkel*)))
(setq cosEff (cos (* winkel-eff (/ pi 180.0)))
sinEff (sin (* winkel-eff (/ pi 180.0))))
(setq ergebnis-liste
(cons (vf-winkel-solve winkel richtung A B sinα cosEff sinEff sin3 cos3)
ergebnis-liste))
)
)
)
(setq ergebnis-liste (reverse ergebnis-liste))
(princ "\n\n=================================================================================")
(princ (ssg-text "vfs-ergebnistabelle-header"))
(princ "\n=================================================================================")
(princ (ssg-text "vfs-tabelle-spalten"))
(princ "\n=================================================================================")
(setq best-winkel nil best-L_GF nil best-L_VF nil)
(foreach item ergebnis-liste
(setq winkel (car item) L_GF (cadr item) L_VF (caddr item) gueltig (cadddr item))
(if (and (numberp L_GF) (numberp L_VF))
(progn
(princ (ssg-textf "vfs-tabelle-zeile"
(list (itoa winkel) (chr 176) (fmt L_GF) (fmt L_VF))))
(if gueltig
(progn
(princ (ssg-text "vfs-status-gueltig"))
(if (or (null best-winkel) (< winkel best-winkel))
(setq best-winkel winkel best-L_GF L_GF best-L_VF L_VF)
)
)
(princ (ssg-text "vfs-status-ungueltig"))
)
)
(princ (ssg-textf "vfs-tabelle-zeile-fehler" (list (itoa winkel) (chr 176))))
)
)
(princ "\n=================================================================================")
(if best-winkel
(princ (ssg-textf "vfs-empfohlener-winkel" (list (itoa best-winkel) (chr 176))))
(princ (ssg-text "vfs-kein-winkel-gefunden"))
)
(list best-winkel best-L_GF best-L_VF ergebnis-liste)
)
;; Prueft/berechnet die Variante mit HORIZONTALER Zwischenstrecke (Schritt
;; 6/11 bei 0 Grad statt geneigt). Die beiden Vertikalboegen sind dabei
;; IMMER auf 3 Grad fixiert (Vario_Bogen_auf_3 / Vario_Bogen_ab_3), weil sie
;; nur zwischen der festen 3-Grad-Neigung von Umlenk-/Motorstation und der
;; horizontalen Mitte vermitteln muessen - unabhaengig von Auf/Ab.
;; WICHTIG (geometrische Konsequenz): GF1+GF2 (an AS/ES-Seite, ebenfalls
;; fest bei 3 Grad geneigt) sind die einzige nennenswerte Quelle fuer
;; Hoehenaenderung, da sich die beiden Boegen gegenseitig fast vollstaendig
;; kompensieren. Die feste 3-Grad-Neigung wirkt IMMER absenkend:
;; - "Ab": passt zur gewuenschten Absenkung -> deltaH praktisch beliebig
;; erreichbar (im Rahmen von deltaL), GF1+GF2 werden einfach laenger.
;; - "Auf": wirkt der gewuenschten Steigung entgegen -> nur fuer SEHR
;; KLEINE deltaH ueberhaupt gueltig (wenige cm).
;; schon-flach: T => KEIN Bogen1 (auf_3) am Eintritt - der Aufrufer ist
;; bereits flach (0 Grad) angekommen und wird KEINEN Uebergangsbogen bauen
;; (vermeidet ein ueberfluessiges auf_3/ab_3-Paar, wenn eine bereits flache
;; Kette ohnehin ein horizontales Mittelstueck braucht - siehe
;; vfl-body-abschluss). Default nil (unveraendertes Verhalten fuer alle
;; anderen Aufrufer, die immer von der 3-Grad-Basis starten).
;; Rueckgabe: (GF_total L_VF gueltig) oder nil falls Boegen nicht messbar.
(defun berechne-horizontale-mitte (deltaL deltaH richtung schon-flach /
mass1 mass2 rad3 bogen-x1 bogen-z1
bogen-x2 bogen-z2 deltaH-signiert
A-hz B-hz GF_total L_VF-hz gueltig)
(setq mass1 (if schon-flach t (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*))))
(setq mass2 (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(if (or (null mass1) (null mass2))
nil
(progn
(setq rad3 (* *vfk-gefaelle-winkel* (/ pi 180.0)))
;; Bogen1 (immer auf_3): Eintritt bei 3 Grad (von Umlenkstation), biegt
;; auf 0 Grad - entfaellt bei schon-flach (kein Eintrittsbogen noetig).
(if schon-flach
(setq bogen-x1 0.0 bogen-z1 0.0)
(progn
(setq bogen-x1 (+ (* (car mass1) (cos rad3)) (* (caddr mass1) (sin rad3))))
(setq bogen-z1 (+ (* (- (car mass1)) (sin rad3)) (* (caddr mass1) (cos rad3))))
)
)
;; Bogen2 (immer ab_3): Eintritt bei 0 Grad (von der horizontalen Mitte), biegt auf 3 Grad
(setq bogen-x2 (car mass2))
(setq bogen-z2 (caddr mass2))
;; Signierte Ziel-Hoehenaenderung: Auf=+deltaH, Ab=-deltaH
(setq deltaH-signiert (if (= richtung "Auf") deltaH (- deltaH)))
;; Horizontal-Budget: deltaL minus AS/ES minus beide Boegen minus feste Stationen (bei 3 Grad)
(setq A-hz (- deltaL aus-dx ein-dx bogen-x1 bogen-x2
(* FESTE_HORIZONTAL (cos rad3))))
;; Hoehen-Budget: was GF1+GF2 (bei 3 Grad) noch beitragen muessen
(setq B-hz (- (+ aus-dz ein-dz (- (* FESTE_HORIZONTAL (sin rad3)))
bogen-z1 bogen-z2)
deltaH-signiert))
(setq GF_total (/ B-hz (sin rad3)))
(setq L_VF-hz (- A-hz (* GF_total (cos rad3))))
(setq gueltig (and (>= GF_total 0) (>= L_VF-hz 0)))
(list GF_total L_VF-hz gueltig)
)
)
)
;; Stufe 3 (Fallback fuer vfl-winkel-stufe-entscheidung, vf_linienzug.lsp):
;; gewinkelter S-Bogen (Tabellenwinkel) UND horizontales Fuellstueck
;; kombiniert, wenn WEDER Stufe 1 (reiner Tabellenwinkel) NOCH Stufe 2
;; (berechne-horizontale-mitte, reine Horizontale) eine gueltige Loesung
;; liefern. GF wird FIX auf *vfl-gf-min-laenge* gesetzt (Konvention wie die
;; "climber"-Randbedingung in Modus 2/3) statt wie in Stufe 1 simultan
;; geloest - aus der Hoehenbilanz bleibt dann genau L_VF, aus der
;; Laengenbilanz der Rest als L_hor (horizontales Fuellstueck vor ODER nach
;; dem S-Bogen - Position waehlt der Anwender, siehe vfl-winkel-stufe-
;; entscheidung).
;;
;; Herleitung: vf-winkel-solve loest fuer einen Kandidatenwinkel implizit
;; das 2x2-System (durch Ruecksubstitution der dortigen Cramer-Loesung
;; rekonstruiert, winkel-eff=winkel-*vfk-gefaelle-winkel* fuer "Auf"):
;; cos3*L_GF + cosEff*L_VF = A (Laengenbilanz)
;; -sin3*L_GF + sinEff*L_VF = B (Hoehenbilanz)
;; Mit L_GF fix ergibt die Hoehenbilanz L_VF, die Laengenbilanz danach L_hor.
;;
;; Das Fuellstueck braucht sein EIGENES 3-Grad-Uebergangsbogenpaar (auf_3+
;; ab_3, wie in berechne-horizontale-mitte) - dieser Fussabdruck ist NICHT
;; gratis und wird hier VORAB von A/B abgezogen, sonst wiederholt sich der
;; reale dZ-Fehler aus der Historie (siehe Kommentar bei vfl-winkel-stufe-
;; entscheidung, vf_linienzug.lsp).
;;
;; Absichtlich eng gehalten (kein Blackbox-Rateversuch):
;; - Nur "Auf" implementiert. "Ab" faellt laut bestehendem Kommentar bei
;; vfl-winkel-stufe-entscheidung fast immer schon unter Stufe 2 - ohne
;; einen konkreten Bedarfsfall bleibt der "Ab"-Zweig hier ein
;; dokumentiertes TODO statt einer ungetesteten Vermutung.
;; - schon-flach NICHT unterstuetzt: welcher der beiden Uebergangsboegen
;; (Fuellstueck oder S-Bogen) dabei entfallen wuerde, haengt von der -
;; zum Zeitpunkt der Berechnung noch unbekannten - Position (vor/nach)
;; ab. Stufe 3 liefert in diesem Fall bewusst KEIN Ergebnis statt eine
;; der beiden Moeglichkeiten zu raten.
;;
;; Rueckgabe: (list winkel L_GF L_VF L_hor gueltig) beim ersten (flachsten)
;; Kandidatenwinkel mit L_VF>=0 UND L_hor>=0, sonst (list nil nil nil nil nil).
(defun vfl-stufe3-winkel-horizontal (deltaL deltaH richtung feste-hz schon-flach /
winkel-list mass-f1 mass-f2 sin3 cos3
bogen-x1f bogen-z1f bogen-x2f bogen-z2f
A-frei B-frei mass1 mass2 ab-erg A B
winkel-eff sinEff cosEff gf-min
L_GF L_VF L_hor winkel treffer)
(if (or (/= richtung "Auf") schon-flach)
(list nil nil nil nil nil)
(progn
(setq gf-min (if (and (boundp '*vfl-gf-min-laenge*) *vfl-gf-min-laenge*)
*vfl-gf-min-laenge* 400.0))
(setq sin3 (sin (* *vfk-gefaelle-winkel* (/ pi 180.0)))
cos3 (cos (* *vfk-gefaelle-winkel* (/ pi 180.0))))
(setq mass-f1 (get-bogen-mass bogen-auf (fix *vfk-gefaelle-winkel*)))
(setq mass-f2 (get-bogen-mass bogen-ab (fix *vfk-gefaelle-winkel*)))
(if (or (null mass-f1) (null mass-f2))
(list nil nil nil nil nil)
(progn
;; Fuellstueck-Uebergangsboegen (unabhaengig vom Kandidatenwinkel):
;; Bogen1 (auf_3, Eintritt bei 3 Grad, wie in berechne-horizontale-
;; mitte), Bogen2 (ab_3, Eintritt bei 0 Grad - keine Rotation noetig).
(setq bogen-x1f (+ (* (car mass-f1) cos3) (* (caddr mass-f1) sin3)))
(setq bogen-z1f (+ (* (- (car mass-f1)) sin3) (* (caddr mass-f1) cos3)))
(setq bogen-x2f (car mass-f2))
(setq bogen-z2f (caddr mass-f2))
(setq winkel-list (ssg-cfg-or "vario" "bogen_winkel"
'(3 6 9 12 15 18 21 27 33 39 45 51)))
(setq L_GF gf-min treffer nil)
(foreach winkel winkel-list
(if (not treffer)
(progn
(setq mass1 (get-bogen-mass bogen-auf winkel))
(setq mass2 (get-bogen-mass bogen-ab winkel))
(setq ab-erg (vf-winkel-AB winkel richtung mass1 mass2 deltaL deltaH
feste-hz 0.0 0.0 (abs aus-dz) (abs ein-dz) sin3 cos3))
(if ab-erg
(progn
(setq A (car ab-erg) B (cadr ab-erg))
;; Fuellstueck-Fussabdruck vorab abziehen - siehe
;; Kopfkommentar (NICHT gratis).
(setq A-frei (- A bogen-x1f bogen-x2f))
(setq B-frei (- B bogen-z1f bogen-z2f))
(setq winkel-eff (- winkel *vfk-gefaelle-winkel*))
(setq sinEff (sin (* winkel-eff (/ pi 180.0)))
cosEff (cos (* winkel-eff (/ pi 180.0))))
(if (> (abs sinEff) 0.0001)
(progn
(setq L_VF (/ (+ B-frei (* sin3 L_GF)) sinEff))
(setq L_hor (- A-frei (* cos3 L_GF) (* cosEff L_VF)))
(if (and (numberp L_VF) (numberp L_hor)
(>= L_VF 0.0) (>= L_hor 0.0))
(setq treffer (list winkel L_GF L_VF L_hor T))
)
)
)
)
)
)
)
)
(if treffer treffer (list nil nil nil nil nil))
)
)
)
)
)
;; ============================================================
;; TEIL 5: BERECHNE-WRAPPER (Schnittstelle fuer Registry)
;; ============================================================
;; Initialisiert Standard-Bibliothek und berechnet Winkel.
;; seite-Parameter wird fuer Standard-Typ nicht benoetigt (keine Vorab-Geometrie).
;; Die Machbarkeitspruefung fuer die horizontale Zwischenstrecke passiert
;; separat und VORAB in c:VarioFoerderer (vor der Foerderrichtung-Abfrage),
;; deshalb liefert diese Funktion nur noch die normale Winkelsuche zurueck.
(defun berechne-standard (deltaL deltaH richtung seite)
(setq FESTE_HORIZONTAL (ssg-cfg-or "vario" "feste_horizontal" 1600))
(setq staustrecke-basis (ssg-cfg-or "vario" "staustrecke_basis" 1000))
(init-bibliothek)
(berechne-alle-winkel deltaL deltaH richtung nil nil)
)
;; ============================================================
;; TEIL 6: EINFUEGEN (11 Schritte, ohne VF_*-Block-Erstellung)
;; ============================================================
;; Gibt endpunkt zurueck (letzter KS_AUS nach ES_90).
;; VF_*-Block-Erstellung erfolgt zentral im Dispatcher (vf_core.lsp).
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, 180=West/-X,
;; 270=Sued/-Y). Default 0, falls vom Aufrufer nicht mitgegeben (Etage-
;; Registry-Kompatibilitaet - siehe c:VarioFoerderer).
;; --- Teil 1/3: AS-Element (Kettenanfang) ---
;; Eigenstaendig, damit vf-linienzug (Gemischte GF/VF-Kette) ein VF-Segment
;; auch OHNE eigenes AS/ES mitten in der Kette einfuegen kann (vfs-mitte-teil
;; alleine), waehrend ein normaler Standard-VarioFoerderer weiterhin alle 3
;; Teile nacheinander durchlaeuft (siehe variofoerderer-einfuegen unten).
(defun vfs-as-teil (startpunkt seite hz / as-block)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
(setq as-block (strcat "AS_Element_90_" seite))
(if (not *lib-initialized*) (init-bibliothek))
(princ (ssg-textf "vfs-schritt-as" (list as-block (rtos hz 2 1) grad-zeichen)))
(insert-block-by-ks as-block startpunkt hz)
)
;; --- Teil 2a: VF-Eingang (GF1 + Separator + Umlenkstation) ---
;; Beginnt eine reine VF-Einheit: bringt die Kette von der (3-Grad-geneigten)
;; AS-Seite ueber GF1 + Separator bis zur Umlenkstation. Wird pro VF-Einheit
;; GENAU EINMAL aufgerufen (auch wenn danach mehrere Sub-Segmente folgen).
;; ohne-separator: T => der Separator entfaellt (das vorherige Kettenglied
;; IST bereits ein Separator, siehe letzter-typ in vf-linienzug-modus - eine
;; gueltige Trennstelle braucht nur einen Separator, nicht zwei hintereinander).
;; L_GF1 sollte in diesem Fall vom Aufrufer bereits auf 0 gesetzt sein.
(defun vfs-vf-entry (aktueller-punkt L_GF1 hz ohne-separator)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
;; 1. Gefaellestrecke GF1 (verbindet AS-Neigung mit Umlenkstation)
(if (> L_GF1 0.1)
(progn
(princ (ssg-textf "vfs-vf-eingang-gf1" (list (rtos L_GF1 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_GF1 (ssg-cfg-or "vario" "gefaelle_winkel" 3) hz))
)
(princ (ssg-text "vfs-vf-eingang-gf1-skip"))
)
;; 2. Separator (am GF1-Ende / vor Umlenkstation) - entfaellt bei ohne-separator
(if (not ohne-separator)
(progn
(princ (ssg-text "vfs-vf-eingang-separator"))
(setq aktueller-punkt
(insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "separator_block_dx" 300)
(ssg-cfg-or "vario" "separator_block_dz" 0) hz))
)
)
;; 3. Umlenkstation
(princ (ssg-text "vfs-vf-eingang-umlenk"))
(setq aktueller-punkt
(insert-rotated-block-with-ks (strcat "Vario_Umlenkstation_500mm_" (vf-motorseite-aktuell)) aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "station_block_dx" 500)
(ssg-cfg-or "vario" "station_block_dz" 0) hz))
aktueller-punkt
)
;; --- Teil 2b: VF-Koerper (Vertikalbogen + L_VF + Vertikalbogen) ---
;; EIN reines VF-Sub-Segment. Wichtig: es BEGINNT und ENDET auf der
;; 3-Grad-Basisneigung, weil Ein- und Ausgangsbogen denselben Winkel haben.
;; Dadurch lassen sich mehrere Sub-Segmente (und Vario-Kurven dazwischen)
;; beliebig aneinanderreihen (siehe doc/VarioFoerderer_Linienzug_Prinzipien.md).
;; best-winkel=0 => horizontales Sub-Segment (Boegen fest auf_3/ab_3).
(defun vfs-vf-koerper (aktueller-punkt richtung best-winkel L_VF hz /
bogen-name bogen-mass bogen-dx bogen-dz)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
;; 5. 1. Vertikalbogen
;; Sonderfall best-winkel=0 (horizontale Zwischenstrecke, siehe
;; berechne-horizontale-mitte): Boegen IMMER auf_3/ab_3, unabhaengig von
;; Auf/Ab, da sie nur zwischen der festen 3-Grad-Neigung und der
;; horizontalen Mitte vermitteln muessen.
(if (= best-winkel 0)
(progn
(setq bogen-name "Vario_Bogen_auf_3_TEF_rechts")
(setq bogen-mass (get-bogen-mass bogen-auf 3))
)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(princ (ssg-textf "vfs-schritt5-bogen1" (list bogen-name)))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3) bogen-dx bogen-dz hz))
;; 6. Variable Strecke L_VF
(if (> L_VF 0.1)
(progn
(if (= best-winkel 0)
(progn
(princ (ssg-textf "vfs-schritt6-horizontal" (list (rtos L_VF 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF 0 hz))
)
(if (= richtung "Auf")
(progn
(princ (ssg-textf "vfs-schritt6-steigung"
(list (itoa (- (- best-winkel 3))) (rtos L_VF 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (- (- best-winkel 3)) hz))
)
(progn
(princ (ssg-textf "vfs-schritt6-gefaelle"
(list (itoa (+ best-winkel 3)) (rtos L_VF 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_VF (+ best-winkel 3) hz))
)
)
)
)
(princ (ssg-text "vfs-schritt6-skip"))
)
;; 7. 2. Vertikalbogen
(if (= best-winkel 0)
(progn
(setq bogen-name "Vario_Bogen_ab_3_TEF_rechts")
(setq bogen-mass (get-bogen-mass bogen-ab 3))
)
(if (= richtung "Auf")
(progn
(setq bogen-name (strcat "Vario_Bogen_ab_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-ab best-winkel))
)
(progn
(setq bogen-name (strcat "Vario_Bogen_auf_" (itoa best-winkel) "_TEF_rechts"))
(setq bogen-mass (get-bogen-mass bogen-auf best-winkel))
)
)
)
(setq bogen-dx (car bogen-mass) bogen-dz (caddr bogen-mass))
(if (= best-winkel 0)
(progn
(princ (ssg-textf "vfs-schritt7-bogen1" (list bogen-name)))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
0 bogen-dx bogen-dz hz))
)
(if (= richtung "Auf")
(progn
(princ (ssg-textf "vfs-schritt7-bogen-winkel"
(list bogen-name (itoa (- 3 best-winkel)))))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(- 3 best-winkel) bogen-dx bogen-dz hz))
)
(progn
(princ (ssg-textf "vfs-schritt7-bogen-winkel"
(list bogen-name (itoa (+ best-winkel 3)))))
(setq aktueller-punkt
(insert-rotated-block-with-ks bogen-name aktueller-punkt
(+ best-winkel 3) bogen-dx bogen-dz hz))
)
)
)
aktueller-punkt
)
;; --- Teil 2c: VF-Ausgang (Motorstation [+ GF2] [+ Separator]) ---
;; Schliesst eine reine VF-Einheit mit der Motorstation.
;; L_GF2 > 0.1 => GF2 (3 Grad) wird angehaengt (verbindet Motorstation
;; mit der Auslauf-Neigung).
;; mit-separator T => Separator (300 mm) am Ende (Standard-VF: vor ES).
;; Standard-VF: L_GF2 = L_GF/2, mit-separator = t.
;; Linienzug: Separator wird NICHT hier gebaut (er sitzt erst vor dem ES bzw.
;; optional zwischen Foerderern) -> mit-separator = nil; GF2 je nach Wahl.
(defun vfs-vf-exit (aktueller-punkt L_GF2 hz mit-separator)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
;; Motorstation
(princ (ssg-text "vfs-ausgang-motorstation"))
(setq aktueller-punkt
(insert-rotated-block-with-ks (strcat "Vario_Motorstation_500mm_" (vf-motorseite-aktuell)) aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "station_block_dx" 500)
(ssg-cfg-or "vario" "station_block_dz" 0) hz))
;; GF2 (optional, verbindet Motorstation mit der Auslauf-Neigung)
(if (> L_GF2 0.1)
(progn
(princ (ssg-textf "vfs-ausgang-gf2" (list (rtos L_GF2 2 2))))
(setq aktueller-punkt
(insert-inclined-scaled-block "Staustrecke_SP_1000_mm" aktueller-punkt
L_GF2 (ssg-cfg-or "vario" "gefaelle_winkel" 3) hz))
)
(princ (ssg-text "vfs-ausgang-gf2-skip"))
)
;; Separator (optional, nur Standard-VF)
(if mit-separator
(progn
(princ (ssg-text "vfs-ausgang-separator"))
(setq aktueller-punkt
(insert-rotated-block-with-ks "Staustrecke_Separator_SP_300_mm" aktueller-punkt
(ssg-cfg-or "vario" "gefaelle_winkel" 3)
(ssg-cfg-or "vario" "separator_block_dx" 300)
(ssg-cfg-or "vario" "separator_block_dz" 0) hz))
)
)
aktueller-punkt
)
;; --- Teil 2 (Zusammensetzung): Kettenmitte fuer den Standard-VF ---
;; Entry + EIN Koerper + Exit. Verhalten identisch zur bisherigen Fassung.
(defun vfs-mitte-teil (aktueller-punkt richtung best-winkel L_GF1 L_GF2 L_VF hz)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
(setq aktueller-punkt (vfs-vf-entry aktueller-punkt L_GF1 hz nil))
(setq aktueller-punkt (vfs-vf-koerper aktueller-punkt richtung best-winkel L_VF hz))
(setq aktueller-punkt (vfs-vf-exit aktueller-punkt L_GF2 hz t))
aktueller-punkt
)
;; --- Teil 3/3: ES-Element (Kettenende) ---
(defun vfs-es-teil (aktueller-punkt seite hz / es-block)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
(setq es-block (strcat "ES_Element_90_" seite))
(princ (ssg-textf "vfs-schritt11-es" (list es-block (rtos hz 2 1) grad-zeichen)))
(insert-block-by-ks es-block aktueller-punkt hz)
)
;; --- Zusammensetzung: kompletter Standard-VarioFoerderer ---
;; Reine Verkettung von Teil 1+2+3, Verhalten identisch zur bisherigen
;; monolithischen Fassung. deltaL/deltaH werden hier nicht gebraucht (Teil
;; der einfuege-fn-Schnittstelle der Typ-Registry, siehe vf-typ-registrieren).
(defun variofoerderer-einfuegen (deltaL deltaH richtung best-winkel
L_GF1 L_GF2 L_VF startpunkt seite hz
/ aktueller-punkt endpunkt)
(if (null hz) (setq hz 0.0))
(setq hz (float hz))
(setq aktueller-punkt (vfs-as-teil startpunkt seite hz))
(setq aktueller-punkt
(vfs-mitte-teil aktueller-punkt richtung best-winkel L_GF1 L_GF2 L_VF hz))
(setq endpunkt (vfs-es-teil aktueller-punkt seite hz))
(princ "\n\n=========================================")
(princ (ssg-text "vfs-eingefuegt"))
endpunkt
)
;; ============================================================
;; DCL-DIALOG (Standardfall) - dcl/variofoerderer.dcl
;; Ersetzt die interaktive Werteingabe aus vf-eingabe-abfragen
;; (Konsolen-Modus "Werteingabe") fuer anlage-typ "standard" durch
;; zwei DCL-Dialoge: Basis-Eingabe und Winkel/Verteilung. Die
;; 3D-Linie-Eingabe sowie die Typen "etage"/"linienzug" bleiben
;; unveraendert interaktiv (siehe Verzweigung in c:VarioFoerderer).
;; ============================================================
;; Bau-Parameter eines bestehenden VF_n-Blocks aus XDATA + Attributen lesen -
;; gemeinsame Leseroutine fuer den Standard-Edit-Body (c:VARIOFOERDERER_EDIT)
;; und den Etage-Edit-Body (vfe-edit-ent), die frueher denselben Attribut-Lese-
;; + prefill-basis-Aufbau fast wortgleich ausgeschrieben hatten. Einzige
;; Unterschiede waren zwei Defaults (deltaH, seite) - daher Parameter.
;; NICHT zusammengelegt mit vf-konvertiere-ent: das liest dieselben Attribute,
;; liefert aber eine andere Struktur (Einzelwerte + L_VF/L_GF1/L_GF2/hoehe-von/
;; bis fuer den Batch-Konverter statt einer Dialog-prefill-Alist) - eine
;; erzwungene Zusammenfuehrung wuerde beide verkomplizieren.
;; Rueckgabe: Alist mit "prefill-basis" (fuer vfs-dialog-eingabe-basis) plus den
;; Rohwerten "attribs" "startpunkt" "hz" "z-start", die der Aufrufer danach noch
;; fuer prefill-winkel/Neubau braucht.
(defun vfs-edit-basis-lesen (ent xd default-deltah default-seite /
ed attribs startpunkt hz deltaL deltaH richtung seite z-start)
(setq ed (entget ent))
(setq attribs (ssg-attrib-read ent))
(setq startpunkt (cdr (assoc 10 ed)))
(setq hz (atof (nth 1 xd)))
(setq deltaL (atof (cond ((cdr (assoc "DELTA_L_mm" attribs))) ("15000"))))
(setq deltaH (atof (cond ((cdr (assoc "DELTA_H_mm" attribs))) (default-deltah))))
(setq richtung (cond ((cdr (assoc "ANTRIEBFAHRTRICHTUNG" attribs))) ("Auf")))
(setq seite (cond ((cdr (assoc "SEITE_AS" attribs))) (default-seite)))
(setq z-start (caddr startpunkt))
(list
(cons "prefill-basis"
(list (cons "deltaL" deltaL) (cons "deltaH" deltaH) (cons "richtung" richtung)
(cons "einfuegehoehe" z-start) (cons "hz" hz) (cons "seite" seite)
(cons "dim" (cond ((ssg-dim-xdata-lesen ent)) ("3D")))
(cons "geruest-einzelmodul" (cond ((cdr (assoc "GERUEST_EINZELMODUL" attribs))) ("1")))
(cons "geruest-typ" (cdr (assoc "GERUEST_TYP" attribs)))
(cons "motorseite" (cond ((cdr (assoc "MOTORSEITE" attribs))) ("rechts")))))
(cons "attribs" attribs)
(cons "startpunkt" startpunkt)
(cons "hz" hz)
(cons "z-start" z-start)))
;; Basis-Eingabe (Dialog 1): deltaL, deltaH, Richtung, Einfuegehoehe,
;; Fahrtrichtung, Seite, Geruest fuer Einzelmodul, Geruestoption.
;; prefill: Assoziationsliste zur Vorbelegung (fuer VARIOFOERDERER_EDIT) mit
;; Schluesseln "deltaL" "deltaH" "richtung" "einfuegehoehe" "hz" "seite"
;; "geruest-einzelmodul" "geruest-typ" - oder nil fuer Neuanlage mit Defaults.
;; Rueckgabe: (deltaL deltaH richtung einfuegehoehe hz seite
;; geruest-einzelmodul geruest-typ) oder nil bei Abbruch.
(defun vfs-dialog-eingabe-basis (prefill / dcl-pfad dat ergebnis
dlg-deltal dlg-deltah dlg-richtung dlg-hoehe
dlg-fahrtrichtung dlg-seite dlg-motorseite dlg-dimension
dlg-geruest-einzelmodul dlg-geruest-typ
deltaL deltaH richtung hz seite z-start dim motorseite
geruest-einzelmodul geruest-typ)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "variofoerderer_basis" dat))
(progn
(if (>= dat 0) (unload_dialog dat))
(alert (ssg-textf "gf-alert-dialog-fehlt" (list dcl-pfad)))
nil
)
(progn
;; Vorbelegung: aus prefill (Edit) oder Defaults (Neuanlage)
(set_tile "deltal"
(if prefill (rtos (cdr (assoc "deltaL" prefill)) 2 0) "15000"))
(set_tile "deltah"
(if prefill (rtos (cdr (assoc "deltaH" prefill)) 2 0) "3000"))
(set_tile "einfuegehoehe"
(if prefill (rtos (cdr (assoc "einfuegehoehe" prefill)) 2 1) "0"))
(start_list "richtung")
(add_list (ssg-text "vfs-dlg-richtung-auf"))
(add_list (ssg-text "vfs-dlg-richtung-ab"))
(end_list)
(set_tile "richtung"
(if (and prefill (equal (cdr (assoc "richtung" prefill)) "Ab")) "1" "0"))
(start_list "fahrtrichtung")
(add_list (ssg-textf "gf-dlg-richtung-0" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-90" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-180" (list grad-zeichen)))
(add_list (ssg-textf "gf-dlg-richtung-270" (list grad-zeichen)))
(end_list)
(set_tile "fahrtrichtung"
(if prefill
(cond ((equal (cdr (assoc "hz" prefill)) 90.0 0.1) "1")
((equal (cdr (assoc "hz" prefill)) 180.0 0.1) "2")
((equal (cdr (assoc "hz" prefill)) 270.0 0.1) "3")
(t "0"))
"0"))
(start_list "seite")
(add_list (ssg-text "gf-dlg-rechts"))
(add_list (ssg-text "gf-dlg-links"))
(end_list)
(set_tile "seite"
(if (and prefill (equal (cdr (assoc "seite" prefill)) "links")) "1" "0"))
;; Motorseite (Motor-/Umlenkstation links|rechts); Default rechts.
(start_list "motorseite")
(add_list (ssg-text "gf-dlg-rechts"))
(add_list (ssg-text "gf-dlg-links"))
(end_list)
(set_tile "motorseite"
(if (and prefill (equal (cdr (assoc "motorseite" prefill)) "links")) "1" "0"))
;; Darstellung 2D/3D: Vorbelegung aus prefill "dim" (Edit: erkannte
;; Dimension des Blocks), sonst aktueller Modus (Neuanlage -> i.d.R. 3D).
(start_list "dimension")
(add_list "3D")
(add_list "2D")
(end_list)
(set_tile "dimension"
(if (equal (cond ((cdr (assoc "dim" prefill))) ((ssg-ils-dim-aktuell))) "2D") "1" "0"))
(set_tile "geruest_einzelmodul"
(if (or (null prefill) (equal (cdr (assoc "geruest-einzelmodul" prefill)) "1")) "1" "0"))
(start_list "geruest_typ")
(foreach opt *ssg-geruest-optionen* (add_list opt))
(end_list)
(set_tile "geruest_typ"
(itoa (ssg-geruest-typ-to-idx (if prefill (cdr (assoc "geruest-typ" prefill)) nil))))
;; Actions
(action_tile "accept"
(strcat
"(setq dlg-deltal (get_tile \"deltal\"))"
"(setq dlg-deltah (get_tile \"deltah\"))"
"(setq dlg-richtung (get_tile \"richtung\"))"
"(setq dlg-hoehe (get_tile \"einfuegehoehe\"))"
"(setq dlg-fahrtrichtung (get_tile \"fahrtrichtung\"))"
"(setq dlg-seite (get_tile \"seite\"))"
"(setq dlg-motorseite (get_tile \"motorseite\"))"
"(setq dlg-dimension (get_tile \"dimension\"))"
"(setq dlg-geruest-einzelmodul (get_tile \"geruest_einzelmodul\"))"
"(setq dlg-geruest-typ (get_tile \"geruest_typ\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(progn
(setq deltaL (atof dlg-deltal))
(setq deltaH (atof dlg-deltah))
(setq richtung (if (= dlg-richtung "1") "Ab" "Auf"))
(setq z-start (atof dlg-hoehe))
(setq hz
(cond ((= dlg-fahrtrichtung "1") 90.0)
((= dlg-fahrtrichtung "2") 180.0)
((= dlg-fahrtrichtung "3") 270.0)
(t 0.0)))
(setq seite (if (= dlg-seite "1") "links" "rechts"))
(setq motorseite (if (= dlg-motorseite "1") "links" "rechts"))
(setq dim (if (= dlg-dimension "1") "2D" "3D"))
(setq geruest-einzelmodul dlg-geruest-einzelmodul)
(setq geruest-typ (ssg-geruest-idx-to-typ (atoi dlg-geruest-typ)))
(list deltaL deltaH richtung z-start hz seite dim geruest-einzelmodul geruest-typ motorseite)
)
nil
)
)
)
)
;; Winkel/Verteilung-Eingabe (Dialog 2): Winkel-Popup aus den vorher
;; berechneten gueltigen Varianten (gueltige-winkel/ergebnis-liste, siehe
;; berechne-alle-winkel), plus L_GF-Verteilung vorne/hinten (analog Schritt
;; 8+9 in c:VarioFoerderer).
;; prefill: Assoziationsliste ("winkel" . best-winkel) ("verteilung-idx" . "0".."3")
;; ("lgf1" . mm) - oder nil fuer Vorbelegung mit dem kleinsten gueltigen Winkel.
;; Rueckgabe: (best-winkel L_GF L_VF L_GF1 L_GF2 verteilung-modus) oder nil bei Abbruch.
(defun vfs-dialog-winkel-verteilung (gueltige-winkel ergebnis-liste staustrecke-basis prefill /
dcl-pfad dat ergebnis w eintrag idx sel-idx init-verteilung
dlg-winkel dlg-verteilung dlg-lgf1
best-winkel L_GF L_VF verteilung-modus L_GF1 L_GF2)
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/variofoerderer.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "variofoerderer_winkel" dat))
(progn
(if (>= dat 0) (unload_dialog dat))
(alert (ssg-textf "gf-alert-dialog-fehlt" (list dcl-pfad)))
nil
)
(progn
;; Winkel-Popup aus den gueltigen Varianten aufbauen
(start_list "winkel")
(foreach w gueltige-winkel
(setq eintrag (assoc w ergebnis-liste))
(if (= w 0)
(add_list (ssg-textf "vfs-dlg-winkel-horizontal"
(list (rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
(add_list (ssg-textf "vfs-dlg-winkel-option"
(list (itoa w) grad-zeichen (rtos (nth 1 eintrag) 2 1) (rtos (nth 2 eintrag) 2 1))))
)
)
(end_list)
;; Vorbelegung: Winkel aus prefill (falls noch gueltig), sonst erster
;; (kleinster) gueltiger Winkel - analog der automatischen Konsolen-Wahl.
(setq sel-idx 0 idx 0)
(if prefill
(foreach w gueltige-winkel
(if (equal w (cdr (assoc "winkel" prefill))) (setq sel-idx idx))
(setq idx (1+ idx))
)
)
(set_tile "winkel" (itoa sel-idx))
;; Verteilung: Popup + manuelles L_GF1-Feld (nur bei "Eigene Werte" aktiv)
(start_list "verteilung")
(add_list (ssg-text "vfs-dlg-verteilung-1"))
(add_list (ssg-text "vfs-dlg-verteilung-2"))
(add_list (ssg-text "vfs-dlg-verteilung-3"))
(add_list (ssg-text "vfs-dlg-verteilung-4"))
(end_list)
(setq init-verteilung (if prefill (cdr (assoc "verteilung-idx" prefill)) "0"))
(set_tile "verteilung" init-verteilung)
(set_tile "lgf1_manuell"
(if (and prefill (cdr (assoc "lgf1" prefill)))
(rtos (cdr (assoc "lgf1" prefill)) 2 1) "0"))
(mode_tile "lgf1_manuell" (if (= init-verteilung "3") 0 1))
(action_tile "verteilung"
"(mode_tile \"lgf1_manuell\" (if (= (get_tile \"verteilung\") \"3\") 0 1))")
(action_tile "accept"
(strcat
"(setq dlg-winkel (get_tile \"winkel\"))"
"(setq dlg-verteilung (get_tile \"verteilung\"))"
"(setq dlg-lgf1 (get_tile \"lgf1_manuell\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
(if (= ergebnis 1)
(progn
(setq best-winkel (nth (atoi dlg-winkel) gueltige-winkel))
(setq eintrag (assoc best-winkel ergebnis-liste))
(setq L_GF (nth 1 eintrag) L_VF (nth 2 eintrag))
(setq verteilung-modus dlg-verteilung)
(cond
((= verteilung-modus "0")
(setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
((= verteilung-modus "1")
(setq L_GF1 (float staustrecke-basis))
(setq L_GF2 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "2")
(setq L_GF2 (float staustrecke-basis))
(setq L_GF1 (max 0.0 (- L_GF (float staustrecke-basis)))))
((= verteilung-modus "3")
(setq L_GF1 (atof dlg-lgf1))
(if (or (null L_GF1) (< L_GF1 0)) (setq L_GF1 (/ L_GF 2.0)))
(if (> L_GF1 L_GF) (setq L_GF1 L_GF))
(setq L_GF2 (max 0.0 (- L_GF L_GF1))))
(t (setq L_GF1 (/ L_GF 2.0) L_GF2 (/ L_GF 2.0)))
)
(list best-winkel L_GF L_VF L_GF1 L_GF2 verteilung-modus)
)
nil
)
)
)
)
;; ============================================================
;; XDATA-Metadaten fuer den Edit-Nachbau (App "SSG_VF_EDIT").
;; Markiert ein VF_n-INSERT als "mit dem Standard-Dialog erstellt" und
;; speichert die Fahrtrichtung (hz) - der einzige Wert, der sich nicht aus
;; den Sivas-Attributen rekonstruieren laesst (ANTRIEBFAHRTRICHTUNG, SEITE_AS,
;; VF_WINKEL, L_GF_m stehen dort bereits). Bewusst NICHT im Sivas-Attributsatz.
;; Ohne diese Markierung (z.B. Etage-, Linienzug- oder Altbestand-Bloecke)
;; verweigert c:VARIOFOERDERER_EDIT die Bearbeitung, um deren komplexere
;; Geometrie nicht versehentlich durch einen einfachen Neuaufbau zu ersetzen.
;; ============================================================
(if (null *vf-xdata-app*) (setq *vf-xdata-app* "SSG_VF_EDIT"))
;; Allgemeiner Schreiber: markiert ein VF_n-INSERT mit Typ-Marker + hz. Der
;; Typ ("standard"/"etage") steuert beim Edit (c:VARIOFOERDERER_EDIT) den
;; passenden Neuaufbau-Zweig. hz ist der einzige nicht aus den Attributen
;; rekonstruierbare Wert (Baurichtung).
(defun vf-edit-xdata-schreiben (ent typ hz /)
(regapp *vf-xdata-app*)
(entmod
(append (entget ent)
(list
(list -3
(list *vf-xdata-app*
(cons 1000 typ)
(cons 1000 (rtos (float hz) 2 4)))))))
ent
)
;; Rueckwaerts-kompatibler Wrapper fuer den Standard-Typ.
(defun vfs-xdata-schreiben (ent hz /)
(vf-edit-xdata-schreiben ent "standard" hz)
)
;; XDATA lesen -> (typ-marker hz-str) oder nil.
(defun vfs-xdata-lesen (ent / xd app-data)
(setq xd (entget ent (list *vf-xdata-app*)))
(setq app-data (cdr (assoc -3 xd)))
(if app-data
(mapcar 'cdr (cdr (car app-data)))
nil
)
)
;; ============================================================
;; Gemeinsame Berechnung + Winkel/Verteilung-Dialog + Einfuegung.
;; Wird sowohl von der Neuanlage (vfs-standard-dialog-ablauf) als auch vom
;; Edit-Befehl (c:VARIOFOERDERER_EDIT) verwendet.
;; winkel-prefill: Vorbelegung fuer vfs-dialog-winkel-verteilung oder nil.
;; ============================================================
;; Duenne Wrapper: der gemeinsame Ablauf liegt jetzt in vf_core
;; (vf-dialog-berechnen-einfuegen / vf-dialog-ablauf). Standard = mit
;; horizontaler Zwischenstrecke (horizontal-p T).
(defun vfs-standard-dialog-berechnen-einfuegen (vf-nummer deltaL deltaH richtung startpunkt hz seite
winkel-prefill geruest-einzelmodul geruest-typ)
(vf-dialog-berechnen-einfuegen "standard" vf-nummer deltaL deltaH richtung startpunkt hz seite
winkel-prefill geruest-einzelmodul geruest-typ T))
;; Neuanlage (Menue/Konsole -> Dialog). Duenner Wrapper auf den gemeinsamen
;; vf-dialog-ablauf (vf_core); Standard = mit horizontaler Zwischenstrecke.
(defun vfs-standard-dialog-ablauf (vf-nummer)
(vf-dialog-ablauf "standard" vf-nummer T))
;; Nicht-interaktive Umwandlung EINES bestehenden VF-Blocks (Standard ODER
;; Etage) in die Zieldimension (fuer die Batch-Umschaltung "Alle auf 2D/3D").
;; Liest alle Parameter aus XDATA/Attributen (ohne Winkel-Dialog), erzwingt die
;; Zieldim per Override und baut am selben Startpunkt neu auf. Der Typ-Marker
;; der XDATA ("standard"/"etage") waehlt die passende Einfuege-Funktion aus der
;; Typ-Registry (beide haben dieselbe Signatur). Rueckgabe: T/nil.
(defun vf-konvertiere-ent (ent ziel-dim / ed bname xd typ einfuege-fn attribs startpunkt hz
deltaL deltaH richtung seite best-winkel L_GF_m-teile
L_GF1 L_GF2 L_VF hoehe-von hoehe-bis lastEnt vf-insert vf-nummer
geruest-einzelmodul geruest-typ motorseite)
(setq ed (entget ent) bname (cdr (assoc 2 ed)))
(setq xd (vfs-xdata-lesen ent))
(setq typ (if xd (car xd)))
(setq einfuege-fn (if typ (nth 2 (assoc typ *vf-typ-registry*))))
(if (and (wcmatch bname "VF_*") (member typ '("standard" "etage")) einfuege-fn)
(progn
(setq attribs (ssg-attrib-read ent))
(setq startpunkt (cdr (assoc 10 ed)))
(setq hz (atof (nth 1 xd)))
(setq deltaL (atof (cond ((cdr (assoc "DELTA_L_mm" attribs))) ("0"))))
(setq deltaH (atof (cond ((cdr (assoc "DELTA_H_mm" attribs))) ("0"))))
(setq richtung (cond ((cdr (assoc "ANTRIEBFAHRTRICHTUNG" attribs))) ("Auf")))
(setq seite (cond ((cdr (assoc "SEITE_AS" attribs))) ("rechts")))
(setq best-winkel (atoi (cond ((cdr (assoc "VF_WINKEL" attribs))) ("0"))))
(setq L_GF_m-teile (ssg-cfg-split-comma (cond ((cdr (assoc "L_GF_m" attribs))) ("0.0,0.0"))))
(setq L_GF1 (* 1000.0 (atof (car L_GF_m-teile))))
(setq L_GF2 (* 1000.0 (atof (cadr L_GF_m-teile))))
(setq L_VF (* 1000.0 (atof (cond ((cdr (assoc "L_VF_m" attribs))) ("0.0")))))
;; bestehende Geruest-Einstellungen + Motorseite erhalten
(setq geruest-einzelmodul (cond ((cdr (assoc "GERUEST_EINZELMODUL" attribs))) ("0")))
(setq geruest-typ (cdr (assoc "GERUEST_TYP" attribs)))
(setq motorseite (cond ((cdr (assoc "MOTORSEITE" attribs))) ("rechts")))
(setq hoehe-von (caddr startpunkt))
(setq hoehe-bis (cond ((= richtung "Auf") (+ hoehe-von deltaH))
((= richtung "Ab") (- hoehe-von deltaH))
(t hoehe-von)))
(setq *ssg-ils-dim* ziel-dim)
(setq *vf-motorseite* motorseite)
(entdel ent)
(setq lastEnt (vf-lastent-ohne-attribute))
(apply einfuege-fn
(list deltaL deltaH richtung best-winkel L_GF1 L_GF2 L_VF startpunkt seite hz))
(setq vf-nummer (vf-next-number))
(setq vf-insert
(vf-block-erstellen typ seite vf-nummer 0
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))
(setq *ssg-ils-dim* nil)
(setq *vf-motorseite* nil)
(if vf-insert T nil))
nil))
;; ============================================================
;; VARIOFOERDERER_EDIT - Doppelklick/Kontextmenue-Bearbeitung
;; ============================================================
;; Bearbeitet einen bestehenden Standard-VarioFoerderer (VF_n-Block, mit
;; SSG_VF_EDIT-XDATA) ueber die DCL-Dialoge: liest die aktuellen Parameter,
;; zeigt sie vorbelegt und baut die Strecke bei OK am selben Startpunkt neu
;; auf. Wird vom Doppelklick-Dispatcher SSG_BLOCKEDIT fuer Blocknamen "VF_*"
;; aufgerufen. Bloecke ohne SSG_VF_EDIT-XDATA (Etage, Linienzug, Altbestand)
;; werden abgewiesen, da ihre Geometrie sich nicht verlustfrei aus dem
;; einfachen Standard-Schema rekonstruieren laesst.
(defun c:VARIOFOERDERER_EDIT ( / ss ent ed bname startpunkt attribs xd
deltaL deltaH richtung z-start hz seite dim
eingabe vf-nummer best-winkel-attr L_GF_m-teile
prefill-basis prefill-winkel basis-lesung
geruest-einzelmodul geruest-typ motorseite)
;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf)
(setq ss (ssget "I"))
(if (and ss (= (sslength ss) 1)
(= (cdr (assoc 0 (entget (ssname ss 0)))) "INSERT"))
(setq ent (ssname ss 0))
)
(ssg-start "VARIOFOERDERER_EDIT" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(if (null ent)
(progn
(setq ss (ssget ":S" '((0 . "INSERT"))))
(if ss (setq ent (ssname ss 0)))
)
)
(if (null ent) (progn (ssg-end) (exit)))
(setq ed (entget ent))
(setq bname (cdr (assoc 2 ed)))
(if (not (wcmatch bname "VF_*"))
(progn (alert (ssg-textf "vfs-edit-kein-vf" (list bname))) (ssg-end) (exit)))
(setq xd (vfs-xdata-lesen ent))
(if (null xd)
(progn (alert (ssg-textf "vfs-edit-keine-xdata" (list bname))) (ssg-end) (exit)))
;; Typ-Dispatch: Etage-Bloecke gehen in den Etage-Edit-Zweig (vfe-edit-ent in
;; vf_etage.lsp) und laufen innerhalb der bereits geoeffneten ssg-start-Sitzung
;; weiter. Standard-Bloecke fallen unten in den bisherigen Ablauf. Andere
;; Marker (Linienzug/Altbestand) werden abgewiesen.
(if (= (car xd) "etage")
(progn (vfe-edit-ent ent) (ssg-end) (exit)))
;; Linienzug-Bloecke tragen als Marker "linienzug" (Modus 1) oder
;; "linienzug2" (Modus 2) + serialisiertes Eingabe-Journal (vf_linienzug.lsp).
;; vfl-edit-ent liest den Marker selbst erneut und dispatcht intern weiter
;; (Modus 1: Glieder zuruecknehmen + Replay; Modus 2: voller Reset).
(if (member (car xd) '("linienzug" "linienzug2"))
(progn (vfl-edit-ent ent) (ssg-end) (exit)))
(if (/= (car xd) "standard")
(progn (alert (ssg-textf "vfs-edit-keine-xdata" (list bname))) (ssg-end) (exit)))
;; Bau-Parameter + prefill-basis lesen (gemeinsame Leseroutine, siehe
;; vfs-edit-basis-lesen). Standard-Defaults: deltaH "3000", Seite "rechts".
(setq basis-lesung (vfs-edit-basis-lesen ent xd "3000" "rechts"))
(setq prefill-basis (cdr (assoc "prefill-basis" basis-lesung)))
(setq attribs (cdr (assoc "attribs" basis-lesung)))
(setq startpunkt (cdr (assoc "startpunkt" basis-lesung)))
(setq hz (cdr (assoc "hz" basis-lesung)))
(setq z-start (cdr (assoc "z-start" basis-lesung)))
(setq eingabe (vfs-dialog-eingabe-basis prefill-basis))
(if (null eingabe)
(princ (ssg-text "vfc-vorgang-abgebrochen"))
(progn
(vf-basis-eingabe-entpacken eingabe)
(setq startpunkt (list (car startpunkt) (cadr startpunkt) z-start))
;; Vorbelegung Winkel/Verteilung: bestehenden Winkel vorschlagen, L_GF-
;; Verteilung als "Eigene Werte" mit dem aktuellen L_GF1 (aus L_GF_m) -
;; das ist unabhaengig vom urspruenglichen Verteilungsmodus immer exakt.
(setq best-winkel-attr (atoi (cond ((cdr (assoc "VF_WINKEL" attribs))) ("0"))))
(setq L_GF_m-teile (ssg-cfg-split-comma (cond ((cdr (assoc "L_GF_m" attribs))) ("0.0,0.0"))))
(setq prefill-winkel
(list (cons "winkel" best-winkel-attr)
(cons "verteilung-idx" "3")
(cons "lgf1" (* 1000.0 (atof (car L_GF_m-teile))))))
;; Gewaehlte Dimension (2D/3D) + Motorseite fuer den Neubau erzwingen
;; (Override); vf-block-erstellen schreibt beides zugleich neu (Dim-XDATA
;; bzw. MOTORSEITE-Attribut).
(setq *ssg-ils-dim* dim)
(setq *vf-motorseite* motorseite)
(entdel ent)
(setq vf-nummer (vf-next-number))
(vfs-standard-dialog-berechnen-einfuegen vf-nummer deltaL deltaH richtung
startpunkt hz seite prefill-winkel geruest-einzelmodul geruest-typ)
(setq *ssg-ils-dim* nil)
(setq *vf-motorseite* nil)
(princ (ssg-textf "vfs-edit-neu-aufgebaut" (list bname)))
)
)
(ssg-end)
(princ)
)
;; ============================================================
;; VARIOFOERDERER_NACHRUESTEN - Bestandsbloecke markieren
;; ============================================================
;; Versieht bestehende VF_n-Bloecke, die noch KEINEN SSG_VF_EDIT-Marker tragen
;; (vor Einfuehrung der Dialog-/Edit-Unterstuetzung erzeugt), nachtraeglich mit
;; dem Marker (Typ + Baurichtung hz). Danach sind sie per Doppelklick editierbar
;; (c:VARIOFOERDERER_EDIT) und per SSG_DIM_SWITCH 2D/3D-umschaltbar
;; (vf-konvertiere-ent).
;;
;; Es wird NUR die XDATA geschrieben - keine Geometrie veraendert. Der Typ wird
;; aus den Attributen erkannt (Etage traegt GF_Bogen_R_60/L_60, sonst Standard).
;; Die Baurichtung hz laesst sich NICHT aus den Attributen rekonstruieren und
;; wird deshalb pro Block abgefragt (Default = zuletzt eingegebener Wert; bei
;; Neuanlage 0). Wer hz nicht kennt: der Wert steht in der urspruenglichen
;; Bau-Eingabe (z.B. mubea.json "hz") bzw. ergibt sich aus der Ausrichtung.
;; Bereits markierte Bloecke und Nicht-VF-Bloecke werden uebersprungen.
(defun c:VARIOFOERDERER_NACHRUESTEN ( / ss i ent ed bname attribs xd typ hz
n-neu n-skip default-hz)
(ssg-start "VARIOFOERDERER_NACHRUESTEN" nil)
(princ (ssg-text "vfs-nachruesten-titel"))
(setq ss (ssget '((0 . "INSERT") (2 . "VF_*"))))
(if (null ss)
(progn
(princ (ssg-text "vfs-nachruesten-keine-bloecke"))
(ssg-end)
(exit)))
(setq i 0 n-neu 0 n-skip 0 default-hz 0.0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ed (entget ent) bname (cdr (assoc 2 ed)))
(setq xd (vfs-xdata-lesen ent))
(cond
;; Schon markiert (standard/etage) -> ueberspringen
((and xd (member (car xd) '("standard" "etage")))
(princ (ssg-textf "vfs-nachruesten-bereits-markiert" (list bname (car xd))))
(setq n-skip (1+ n-skip)))
(t
(setq attribs (ssg-attrib-read ent))
;; Typ-Erkennung: Etage traegt die Gefaellebogen-Zaehler GF_Bogen_R/L_60.
(setq typ
(if (or (assoc "GF_Bogen_R_60" attribs) (assoc "GF_Bogen_L_60" attribs))
"etage" "standard"))
(princ (ssg-textf "vfs-nachruesten-erkannt" (list bname typ)))
(setq hz (getreal (ssg-textf "vfs-nachruesten-prompt-hz" (list (rtos default-hz 2 1)))))
(if (null hz) (setq hz default-hz))
(setq default-hz hz)
(vf-edit-xdata-schreiben ent typ hz)
(princ (ssg-textf "vfs-nachruesten-markiert" (list (rtos hz 2 1))))
(setq n-neu (1+ n-neu)))
)
(setq i (1+ i))
)
(princ (ssg-textf "vfs-nachruesten-fertig" (list (itoa n-neu) (itoa n-skip))))
(ssg-end)
(princ)
)
;; Kurz-Alias
(defun c:VF_NACHRUESTEN () (c:VARIOFOERDERER_NACHRUESTEN))
;; ============================================================
;; REGISTRIERUNG
;; ============================================================
(vf-typ-registrieren
"standard"
'berechne-standard
'variofoerderer-einfuegen
(ssg-text "vfc-typ-standard-beschreibung"))
(princ)
Reference in New Issue View Git Blame Copy Permalink