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

Varioförderer Aufbau enthält jetzt einen Historien Stack. Beim Abbruch können alle Elemente wiederhergestellt werden und dann einfach weiter gebaut.

Browse Source
This commit is contained in:
Michael Stangl
2026-08-25 16:09:22 +02:00
parent f5d0e57132
commit 236808f4dc
5 changed files with 571 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/vf_linienzug.lsp
+434 -109
View File
@@ -111,6 +111,249 @@
(defun vfl-as-winkel () (if (boundp '*vfl-as-winkel*) *vfl-as-winkel* "90"))
(defun vfl-es-winkel () (if (boundp '*vfl-es-winkel*) *vfl-es-winkel* "90"))
;; ============================================================
;; TEIL 0b: EINGABE-JOURNAL (RECORD & REPLAY)
;; ============================================================
;; Jede interaktive Eingabe im Modus-1-Aufrufbaum laeuft ueber die Wrapper
;; vfl-in-point/-string/-real/-int. Diese arbeiten in zwei Modi:
;; Record (*vfl-replay-queue* = nil): normal fragen + in *vfl-journal* anhaengen.
;; Replay (*vfl-replay-queue* gesetzt): naechsten gespeicherten Wert liefern
;; (nicht fragen) und ebenfalls in *vfl-journal* anhaengen. Laeuft die
;; Queue leer, wird ab hier wieder live gefragt (nahtloser Uebergang).
;; Weil der Builder deterministisch bzgl. seiner Eingaben ist, reproduziert das
;; Abspielen desselben Journals exakt dieselbe Kette. *vfl-journal* wird beim
;; Replay komplett neu aufgebaut (durch die erneute Ausfuehrung), die Queue ist
;; nur Lesequelle.
;;
;; Journal-Eintrag: (kind . value) mit kind aus
;; "PT" Punkt (Liste x y z) "STR" String (auch "")
;; "REAL" Realzahl "INT" Ganzzahl
;; "NIL" Abbruch/Default (value nil) "STEP" Glied-Checkpoint (value = Label)
;; *vfl-journal* wird in UMGEKEHRTER Reihenfolge gehalten (neuestes zuerst, cons).
(defun vfl-journal-reset ()
(setq *vfl-journal* '() *vfl-replay-queue* nil *vfl-edit-orig-ent* nil))
;; Eintrag anhaengen (vorn, da Reverse-Reihenfolge).
(defun vfl-journal-record (kind val)
(setq *vfl-journal* (cons (cons kind val) *vfl-journal*)))
;; Glied-Checkpoint setzen (Label spaeter via vfl-journal-steplabel setzbar).
(defun vfl-journal-mark (label)
(vfl-journal-record "STEP" label))
;; Label des JUENGSTEN STEP-Eintrags nachtraeglich setzen (der Segmenttyp steht
;; erst nach der Menue-Auswahl fest, der Marker sitzt aber am Iterationskopf).
(defun vfl-journal-steplabel (label / found)
(setq found nil)
(setq *vfl-journal*
(mapcar
(function (lambda (e)
(if (and (not found) (= (car e) "STEP"))
(progn (setq found t) (cons "STEP" label))
e)))
*vfl-journal*))
label)
;; Naechsten Eingabe-Eintrag aus der Replay-Queue poppen (STEP-Marker dabei
;; ueberspringen - die werden bei der erneuten Ausfuehrung neu erzeugt).
;; Rueckgabe: (value) als 1-elementige Liste, falls ein Eintrag da war
;; (unterscheidet einen echten nil-Wert von einer leeren Queue); nil, wenn die
;; Queue erschoepft ist (danach faellt der Wrapper auf Live-Eingabe zurueck).
(defun vfl-replay-pop ( / e)
(while (and *vfl-replay-queue* (= (car (car *vfl-replay-queue*)) "STEP"))
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*)))
(if *vfl-replay-queue*
(progn
(setq e (car *vfl-replay-queue*))
(setq *vfl-replay-queue* (cdr *vfl-replay-queue*))
(list (cdr e)))
nil))
;; --- Eingabe-Wrapper ---
;; kind steuert nur, wie ein FRISCH live erfasster Wert typisiert wird; beim
;; Replay wird der gespeicherte Wert unveraendert durchgereicht.
(defun vfl-in-point (base prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (vfl-getpoint base prompt)))
(vfl-journal-record (if v "PT" "NIL") v)
v)
(defun vfl-in-string (prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (getstring prompt)))
;; "" (Enter) ist ein gueltiger String, kein Abbruch -> "STR".
(vfl-journal-record (if (eq (type v) 'STR) "STR" "NIL") v)
v)
(defun vfl-in-real (prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (getreal prompt)))
(vfl-journal-record (if v "REAL" "NIL") v)
v)
(defun vfl-in-int (prompt / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (getint prompt)))
(vfl-journal-record (if v "INT" "NIL") v)
v)
;; Generischer Wrapper fuer eine Eingabe, die nicht direkt ein getXXX ist,
;; sondern das Ergebnis einer fragenden Hilfsfunktion (z.B. die gemeinsame
;; vf-frage-element-winkel). livefn ist ein aufrufbares Objekt ohne Argumente;
;; sein Rueckgabewert wird mit dem angegebenen kind journalisiert bzw. beim
;; Replay aus der Queue geliefert (livefn wird dann NICHT aufgerufen).
(defun vfl-in-value (kind livefn / popped v)
(setq popped (if *vfl-replay-queue* (vfl-replay-pop) nil))
(if popped (setq v (car popped)) (setq v (apply livefn nil)))
(vfl-journal-record (if v kind "NIL") v)
v)
;; --- String-Hilfen (generisch, Trenner beliebig) ---
(defun vfl-strjoin (lst sep / s first)
(setq s "" first t)
(foreach x lst
(if first (progn (setq s x) (setq first nil)) (setq s (strcat s sep x))))
s)
(defun vfl-strsplit (s sep / pos out)
(setq out '())
(while (setq pos (vl-string-search sep s))
(setq out (cons (substr s 1 pos) out))
(setq s (substr s (+ pos 1 (strlen sep)))))
(reverse (cons s out)))
;; --- Serialisierung (tagged, selbstbeschreibend) ---
;; Zeilenformat "kind:payload", Eintraege per "\n" verkettet. getstring/getreal
;; liefern nie ein Newline, daher ist "\n" ein sicherer Record-Trenner.
(defun vfl-entry->string (e / k v)
(setq k (car e) v (cdr e))
(cond
((= k "PT") (strcat "PT:" (rtos (car v) 2 6) "," (rtos (cadr v) 2 6) ","
(rtos (caddr v) 2 6)))
((= k "REAL") (strcat "REAL:" (rtos v 2 6)))
((= k "INT") (strcat "INT:" (itoa v)))
((= k "STR") (strcat "STR:" v))
((= k "STEP") (strcat "STEP:" v))
(t "NIL:")))
(defun vfl-string->entry (ln / p kind pay c)
(setq p (vl-string-search ":" ln))
(if (null p)
(cons "NIL" nil)
(progn
(setq kind (substr ln 1 p) pay (substr ln (+ p 2)))
(cond
((= kind "PT")
(setq c (vfl-strsplit pay ","))
(cons "PT" (list (atof (nth 0 c)) (atof (nth 1 c)) (atof (nth 2 c)))))
((= kind "REAL") (cons "REAL" (atof pay)))
((= kind "INT") (cons "INT" (atoi pay)))
((= kind "STR") (cons "STR" pay))
((= kind "STEP") (cons "STEP" pay))
(t (cons "NIL" nil))))))
(defun vfl-journal->string ()
(vfl-strjoin (mapcar 'vfl-entry->string (reverse *vfl-journal*)) "\n"))
(defun vfl-string->journal (s / out)
(setq out '())
(foreach ln (vfl-strsplit s "\n")
(if (> (strlen ln) 0) (setq out (cons (vfl-string->entry ln) out))))
(reverse out))
;; --- Persistenz am VF_n-Block ueber die SSG_VF_EDIT-XDATA-App ---
;; Layout der 1000-Gruppen: [0]="linienzug" (Marker), [1..]=Journal-String in
;; 250-Byte-Chunks (DXF-Limit 255). Rueckwaertskompatibel zum Standard/Etage-
;; Reader vfs-xdata-lesen, der alle 1000-Werte als Liste liefert.
(defun vfl-chunk-string (s n / out len)
(setq out '())
(while (> (setq len (strlen s)) n)
(setq out (cons (substr s 1 n) out))
(setq s (substr s (1+ n))))
(if (> (strlen s) 0) (setq out (cons s out)))
(reverse out))
(defun vfl-journal-xdata-schreiben (ent / chunks appentry)
(if (null *vf-xdata-app*) (setq *vf-xdata-app* "SSG_VF_EDIT"))
(regapp *vf-xdata-app*)
(setq chunks (vfl-chunk-string (vfl-journal->string) 250))
(setq appentry
(cons *vf-xdata-app*
(cons (cons 1000 "linienzug")
(mapcar (function (lambda (c) (cons 1000 c))) chunks))))
(entmod (append (entget ent) (list (list -3 appentry))))
ent)
(defun vfl-journal-xdata-lesen (ent / xd)
(setq xd (vfs-xdata-lesen ent))
(if (and xd (= (car xd) "linienzug"))
(vfl-string->journal (apply 'strcat (cdr xd)))
nil))
;; --- Abbruch-Rollback ---
;; Alle nach lastEnt erzeugten Entities loeschen (Transaktions-Rollback der
;; Teil-Geometrie) und das Journal der vollstaendig abgeschlossenen Glieder
;; (*vfl-journal-commit*) fuer die Wiederaufnahme sichern. Aufgerufen aus dem
;; *error*-Handler von vf-linienzug-modus.
(defun vfl-modus-cleanup (lastEnt / e nxt cnt)
(setq cnt 0 e (if lastEnt (entnext lastEnt) (entnext)))
(while e
(setq nxt (entnext e))
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'entdel (list e))))
(setq cnt (1+ cnt)))
(setq e nxt))
(if (and (boundp '*vfl-edit-orig-ent*) *vfl-edit-orig-ent*)
;; EDIT-Abbruch: den beim Edit vorab geloeschten Original-Block
;; wiederherstellen (entdel ist im laufenden Befehl umkehrbar) und KEIN
;; Resume anbieten - der Ausgangszustand ist ja komplett zurueck.
(progn
(vl-catch-all-apply 'entdel (list *vfl-edit-orig-ent*))
(setq *vfl-edit-orig-ent* nil)
(princ (ssg-textf "vfl-abbruch-edit" (list (itoa cnt)))))
;; FRESH/RESUME-Abbruch: Journal der abgeschlossenen Glieder fuer die
;; Wiederaufnahme sichern.
(if *vfl-journal-commit*
(progn
(setq *vfl-journal-letzter-abbruch* (reverse *vfl-journal-commit*))
(princ (ssg-textf "vfl-abbruch-resume" (list (itoa cnt)))))
(princ (ssg-textf "vfl-abbruch-simpel" (list (itoa cnt))))))
(princ))
;; Replay-Modus scharf schalten: die uebergebene (Vorwaerts-)Journalliste wird
;; zur Lesequelle, *vfl-journal* startet leer und wird bei der erneuten
;; Ausfuehrung neu aufgebaut. Genutzt von vfl-edit-ent und der Wiederaufnahme.
(defun vfl-journal-replay-start (forward-journal)
(setq *vfl-replay-queue* forward-journal *vfl-journal* '()))
;; --- Glied-Zerlegung fuer den Editier-Dialog ---
;; Labels der Glieder (STEP-Marker) in Bau-Reihenfolge.
(defun vfl-journal-glieder (forward-journal / out)
(setq out '())
(foreach e forward-journal
(if (= (car e) "STEP") (setq out (cons (cdr e) out))))
(reverse out))
;; Journal auf die ersten (keep) Glieder kuerzen: Praeambel (vor dem 1. STEP)
;; bleibt immer erhalten; ab dem (keep+1)-ten STEP wird alles verworfen.
(defun vfl-journal-truncate (forward-journal keep / seen out done)
(setq seen 0 out '() done nil)
(foreach e forward-journal
(if (not done)
(if (= (car e) "STEP")
(if (< seen keep)
(progn (setq seen (1+ seen)) (setq out (cons e out)))
(setq done t))
(setq out (cons e out)))))
(reverse out))
;; Internes (sprachneutrales) Glied-Token in lesbaren Text der AKTUELLEN Sprache
;; uebersetzen. Da im Journal nur das Token steht, folgt die Anzeige immer der
;; aktiven Sprache - ein in Deutsch aufgezeichnetes Journal zeigt in englischer
;; UI englische Labels (und umgekehrt).
(defun vfl-glied-label-text (w)
(cond ((= w "GF-Bogen") (ssg-text "vfl-glied-gf-bogen"))
((= w "Linie-GF") (ssg-text "vfl-glied-gf"))
((= w "Linie-VF") (ssg-text "vfl-glied-vf"))
((= w "Horizontal-VF") (ssg-text "vfl-glied-horizontal-vf"))
((= w "Linie") (ssg-text "vfl-glied-linie"))
((= w "?") (ssg-text "vfl-glied-offen"))
(t w)))
;; ============================================================
;; TEIL 1: SEGMENT-ENTSCHEIDUNG (GF oder VF)
;; ============================================================
@@ -135,7 +378,7 @@
(princ (ssg-textf "vfl-winkel-option"
(list idx (car e) (rtos (cadr e) 2 1) (rtos (caddr e) 2 1))))
(setq idx (1+ idx)))
(setq antwort (getint (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige)))))
(setq antwort (vfl-in-int (ssg-textf "vfl-prompt-wahl-bis-n" (list (length gueltige)))))
(if (or (null antwort) (< antwort 1) (> antwort (length gueltige))) (setq antwort 1))
(setq e (nth (1- antwort) gueltige))
(list (nth 0 e) (nth 1 e) (nth 2 e)))))
@@ -301,10 +544,10 @@
(defun vfl-neue-linie-messen (p-akt hz-vorgabe / p2 rad ux uy deltaL hz-aktuell ergebnis fertig)
(setq fertig nil)
(while (not fertig)
(setq p2 (vfl-getpoint p-akt
(setq p2 (vfl-in-point p-akt
(if hz-vorgabe
"\n\nEndpunkt entlang Fahrtrichtung waehlen (bestimmt die Laenge): "
"\n\nEndpunkt der Linie (XY, beliebige Richtung): ")))
(ssg-text "vfl-prompt-endpunkt-fahrtrichtung")
(ssg-text "vfl-prompt-endpunkt-frei"))))
(if (null p2)
(setq ergebnis nil fertig t)
(progn
@@ -320,9 +563,7 @@
;; Fahrtrichtung
(setq deltaL (+ (* (- (car p2) (car p-akt)) ux) (* (- (cadr p2) (cadr p-akt)) uy)))
(if (> deltaL 25000.0)
(princ (strcat "\n>>> FEHLER: Laenge " (rtos (/ deltaL 1000.0) 2 2)
" m ueberschreitet die Foerderer-Maximallaenge von 25 m"
" - bitte anderen Endpunkt waehlen."))
(princ (ssg-textf "vfl-fehler-laenge-max" (list (rtos (/ deltaL 1000.0) 2 2))))
(progn
(setq ergebnis (list deltaL hz-aktuell p2))
(setq fertig t)
@@ -432,7 +673,7 @@
(princ (ssg-text "vfl-sep-vor-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-vor (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "1"))
(setq sep-vor (= (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")) "1"))
(if (and ziel-modus sep-vor) (setq dL (max 100.0 (- dL 300.0))))
;; auf_3-Eintritt nur, wenn noch NICHT flach (sonst flache Zone fortsetzen).
;; dL ist die gewuenschte Reststrecke AB HIER (pt) - der reale Bogen-
@@ -452,7 +693,7 @@
(princ (ssg-text "vfl-sep-nach-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq sep-nach (= (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")) "1"))
(setq sep-nach (= (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")) "1"))
(if (and ziel-modus sep-nach) (setq dL (max 100.0 (- dL 300.0))))
;; Im Ziel-Modus: "Ist der Endpunkt der Foerderer?" JETZT abfragen (statt
;; erst danach in der Aufruferschleife) - der Ausgangs-Fussabdruck
@@ -464,7 +705,7 @@
(princ (ssg-text "vfl-ja-nur-motorstation"))
(princ (ssg-text "vfl-nein-weiterbauen"))
(princ (ssg-text "vfl-ja-motorstation-kettenende"))
(setq ist-ende-antwort (getstring (ssg-text "vfl-prompt-wahl-1-3-def2")))
(setq ist-ende-antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-3-def2")))
(cond
((= ist-ende-antwort "1")
(setq dL (max 100.0 (- dL (car (get-bogen-mass bogen-ab 3)) 500.0
@@ -568,7 +809,7 @@
(progn (princ (ssg-text "vfl-abgebrochen-kein-ziel")) nil)
(progn
(setq dL (car linie-mess) hzn (cadr linie-mess))
(setq hn (getreal (ssg-textf "vfl-prompt-hoehe-kettenende"
(setq hn (vfl-in-real (ssg-textf "vfl-prompt-hoehe-kettenende"
(list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame))))
(setq dH (- hn (caddr (car frame))))
@@ -687,7 +928,7 @@
(princ (ssg-text "vfl-ja-nur-motorstation"))
(princ (ssg-text "vfl-nein-weiterbauen"))
(princ (ssg-text "vfl-ja-motorstation-kettenende"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-3-def2")))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-3-def2")))
)
)
(if (= antwort "1")
@@ -699,10 +940,10 @@
;; Zerlegung (vfl-body-abschluss -> vfl-body-zerlegung -> berechne-
;; alle-winkel) temporaer nullen, damit KEIN ES-Fussabdruck reserviert
;; wird - die Kette endet dann direkt am Zielpunkt ohne Separator+ES.
(princ "\n\nES-Element setzen?")
(princ "\n 1 - Ja")
(princ "\n 2 - Nein (Kette endet direkt am Zielpunkt)")
(setq es-antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(princ (ssg-text "vfl-es-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-es-nein-zielpunkt"))
(setq es-antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq es-gewuenscht (/= es-antwort "2"))
(if (not es-gewuenscht)
(progn (setq save-eindx ein-dx save-eindz ein-dz)
@@ -722,7 +963,7 @@
(princ (ssg-text "vfl-opt-horizontaler-foerderer"))
(princ (ssg-text "vfl-opt-vario-kurve"))
(princ (ssg-text "vfl-opt-auf-ab-foerderer"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-3-def3")))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-3-def3")))
(cond
;; --- Vario-Kurve (aendert hz) ---
((= antwort "2")
@@ -762,7 +1003,7 @@
(setq dL (car linie-mess) hzn (cadr linie-mess))
(if (> dL 1.0)
(progn
(setq hn (getreal (ssg-textf "vfl-prompt-hoehe-endpunkt"
(setq hn (vfl-in-real (ssg-textf "vfl-prompt-hoehe-endpunkt"
(list (rtos (caddr (car frame)) 2 1)))))
(if (null hn) (setq hn (caddr (car frame))))
(setq dH (- hn (caddr (car frame))))
@@ -874,13 +1115,13 @@
(princ (ssg-text "vfl-winkel-30"))
(princ (ssg-text "vfl-winkel-60"))
(princ (ssg-text "vfl-winkel-90"))
(setq antwort (getint (ssg-text "vfl-prompt-wahl-1-3-def3")))
(setq antwort (vfl-in-int (ssg-text "vfl-prompt-wahl-1-3-def3")))
(if (null antwort) (setq antwort 3))
(setq bwinkel (cond ((= antwort 1) 30) ((= antwort 2) 60) (t 90)))
(princ (ssg-text "vfl-gf-bogen-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq bseite (if (= antwort "2") "rechts" "links"))
(vfl-insert-gf-bogen-block frame bwinkel bseite)
)
@@ -934,18 +1175,18 @@
(princ (ssg-text "vfl-opt1-90grad"))
(princ (ssg-text "vfl-opt2-60grad"))
(princ (ssg-text "vfl-opt3-30grad"))
(setq antwort (getint (ssg-text "vfl-prompt-wahl-1-3-def1")))
(setq antwort (vfl-in-int (ssg-text "vfl-prompt-wahl-1-3-def1")))
(if (null antwort) (setq antwort 1))
(setq kwinkel (cond ((= antwort 1) 90) ((= antwort 2) 60) (t 30)))
(princ (ssg-text "vfl-variokurve-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq kseite (if (= antwort "2") "rechts" "links"))
(princ (ssg-text "vfl-variokurve-variante-header"))
(princ (ssg-text "vfl-variante-aussen"))
(princ (ssg-text "vfl-variante-innen"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq kvariante (if (= antwort "1") "aussen" "innen"))
(vfl-insert-vario-kurve-block frame kwinkel kseite kvariante)
)
@@ -987,12 +1228,11 @@
(progn
(setq frame (vfl-insert-as-element "GF" p-aktuell hz-neu 0.0 as-seite))
(setq deltaL (vfl-projiziere-distanz (car frame) pick-punkt hz-neu))
(princ (strcat "\n>>> AS-Element eingefuegt - reale Restlaenge: deltaL="
(rtos deltaL 2 1) " mm."))
(princ (ssg-textf "vfl-info-as-eingefuegt" (list (rtos deltaL 2 1))))
)
(progn
(setq frame (make-frame-from-dir p-aktuell (hz-winkel->xu hz-neu 0.0)))
(princ "\n>>> Kein AS-Element - Kette beginnt direkt am Startpunkt.")
(princ (ssg-text "vfl-info-kein-as"))
)
)
(list frame deltaL)
@@ -1001,11 +1241,13 @@
;; ES-Winkel (30/90) + Seite erst am Kettenende abfragen. Setzt *vfl-es-winkel*
;; und die ES-Masse (ein-dx/dz) fuer die Variante. Rueckgabe: Seite (links/rechts).
(defun vfl-frage-es-seite ( / antwort es-seite)
(setq *vfl-es-winkel* (vf-frage-element-winkel "vf-winkel-ein-header")) ; 30/90 vor Seite
(setq *vfl-es-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-ein-header"))))) ; 30/90 vor Seite
(princ (ssg-text "gf-seite-ein-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq es-seite (if (= antwort "2") "rechts" "links"))
(vf-set-es-masse *vfl-es-winkel* es-seite)
es-seite
@@ -1143,7 +1385,7 @@
(princ (ssg-text "vfl-gf-verteilung-header"))
(princ (ssg-text "vfl-gf-verteilung-haelfte"))
(princ (ssg-text "vfl-gf-verteilung-ganz-einlauf"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq res (vfl-vf-einheit frame hz richtung winkel L_GF L_VF (= antwort "1")))
(setq frame (nth 0 res) es-gewuenscht (nth 3 res))
;; Kettenende? Bei auto-ende (Kettenende-Modus) ohne Frage direkt ES setzen.
@@ -1160,7 +1402,7 @@
(princ (ssg-text "vfl-ist-kettenende-frage"))
(princ (ssg-text "vfl-ja-separator-es"))
(princ (ssg-text "vfl-nein-weiterbauen"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")))
)
)
)
@@ -1218,7 +1460,7 @@
(princ (ssg-text "vfl-sep-an-stelle-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-nein"))
(setq antwort (getstring (ssg-text "vfl-prompt-wahl-1-2-def2")))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-2-def2")))
(if (= antwort "1") (setq frame (vfl-insert-separator frame)))
)
)
@@ -1234,7 +1476,7 @@
frame letzter-typ fertig linie-ende-modus rad3
anzahl-gf anzahl-vf vfl-nummer lastEnt
gf-max-winkel gf-ok kettenanfang pick-punkt
as-vorhanden erg)
as-vorhanden erg old-error vfl-ins)
(princ "\n\n=========================================")
(princ (ssg-text "vfl-modus1-header"))
(princ "\n=========================================")
@@ -1246,34 +1488,35 @@
;; fehlschlagen - deshalb hier pruefen.
(if (null (car (atoms-family 1 '("GF-INSERT-HZ-INCL-SCALED"))))
(progn
(alert (strcat "Gefaellestrecke-Modul nicht geladen!\n"
"Der Linienzug-Typ benoetigt Gefaellestrecke.lsp\n"
"(GF-Segmente und GF-Boegen). Bitte Menue laden."))
(alert (ssg-text "vfl-alert-gf-modul-fehlt"))
(exit)
)
)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(setq startpunkt (vfl-getpoint nil "\n\nStartpunkt der Kette waehlen: "))
(if (null startpunkt) (progn (princ "\nAbgebrochen.") (exit)))
(setq startpunkt (vfl-in-point nil (ssg-text "vfl-prompt-startpunkt-kette")))
(if (null startpunkt) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
;; Hoehe (Z) des Startpunkts abfragen und in die Z-Koordinate uebernehmen.
(setq start-hoehe
(getreal (strcat "\nHoehe (Z) des Startpunkts [" (rtos (caddr startpunkt) 2 1) "]: ")))
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-startpunkt-kette" (list (rtos (caddr startpunkt) 2 1)))))
(if (null start-hoehe) (setq start-hoehe (caddr startpunkt)))
(setq startpunkt (list (car startpunkt) (cadr startpunkt) start-hoehe))
(princ "\n\nAS-Element setzen?")
(princ "\n 1 - Ja")
(princ "\n 2 - Nein (Kette beginnt direkt mit GF/VF am Startpunkt)")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(princ (ssg-text "vfl-as-setzen-frage"))
(princ (ssg-text "vfl-ja"))
(princ (ssg-text "vfl-as-nein"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq as-vorhanden (/= antwort "2"))
(if as-vorhanden
(progn
(setq *vfl-as-winkel* (vf-frage-element-winkel "vf-winkel-aus-header")) ; 30/90 vor Seite
(princ "\n\nAUS-Element (AS_Element_*) - Seite waehlen:")
(princ "\n 1 - Links\n 2 - Rechts")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(setq *vfl-as-winkel*
(vfl-in-value "STR"
(function (lambda () (vf-frage-element-winkel "vf-winkel-aus-header"))))) ; 30/90 vor Seite
(princ (ssg-text "vfl-aus-seite-header"))
(princ (ssg-text "gf-seite-links"))
(princ (ssg-text "gf-seite-rechts"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(setq as-seite (if (= antwort "2") "rechts" "links"))
(vf-set-as-masse *vfl-as-winkel* as-seite) ; Masse fuer Variante
)
@@ -1283,6 +1526,27 @@
(setq vfl-nummer (vf-next-number))
(setq lastEnt (vf-lastent-ohne-attribute))
;; --- Abbruch-Rollback + Wiederaufnahme scharf schalten ---
;; Ab hier wird Geometrie gebaut. Ein *error*-Handler faengt jeden Abbruch
;; (ESC / (exit) / Laufzeitfehler) ab, entfernt die bereits eingefuegte
;; Teil-Geometrie (alles nach lastEnt, siehe vfl-modus-cleanup) und sichert
;; das Journal der bis dahin VOLLSTAENDIG abgeschlossenen Glieder
;; (*vfl-journal-commit*) fuer die Wiederaufnahme. lastEnt/old-error sind zur
;; Aufrufzeit dynamisch gebunden und daher im Handler sichtbar.
(setq *vfl-journal-commit* nil)
(setq old-error *error*)
;; Abbruch-Handler: zuerst *error* zuruecksetzen (kein rekursiver Wiedereintritt
;; bei einem Cleanup-Fehler), dann Teil-Geometrie zuruecknehmen. Laeuft der
;; Aufruf innerhalb einer ssg-start-Sitzung (Edit-Pfad via c:VARIOFOERDERER_EDIT
;; -> vfl-edit-ent), wird diese mit ssg-end sauber geschlossen (Undo-Gruppe,
;; gesicherte Systemvariablen, *error* aus dem Sitzungs-Frame) - sonst bliebe
;; die von ssg-start geoeffnete Undo-Gruppe offen.
(setq *error*
(function (lambda (msg)
(setq *error* old-error)
(vfl-modus-cleanup lastEnt)
(if (and (boundp '*ssg-start-stack*) *ssg-start-stack*) (ssg-end))
(princ))))
(setq p-aktuell startpunkt)
(setq letzter-typ nil fertig nil frame nil)
(setq anzahl-gf 0 anzahl-vf 0)
@@ -1302,16 +1566,26 @@
;; der Nutzer legt den Segmenttyp direkt fest, keine Geometrie-Automatik
;; mehr wie bei "Neue Linie BIS Kettenende" (die bleibt unveraendert und
;; nutzt weiterhin vfl-segment-entscheidung).
(princ "\n\nNaechstes Element waehlen:")
(princ (ssg-text "vfl-naechstes-element-header"))
(setq linie-ende-modus nil)
;; Commit-Schnappschuss: Journalstand NACH dem letzten vollstaendig
;; abgeschlossenen Glied (vor dem Marker der neuen, noch offenen Iteration).
;; Bei Abbruch wird genau dieser Stand als Wiederaufnahme-Journal gesichert
;; (das angefangene Glied faellt weg).
(setq *vfl-journal-commit* *vfl-journal*)
;; Glied-Checkpoint am Iterationskopf setzen; Label wird nach der Auswahl
;; nachgetragen (vfl-journal-steplabel), damit jedes Glied seine eigene
;; Menue-Auswahl + Segment-Eingaben vollstaendig umschliesst (fuer den
;; gliedweisen Ruecksprung beim Editieren).
(vfl-journal-mark "?")
(if frame
(progn
(princ "\n 1 - GF-Bogen (horizontale Kurve)")
(princ "\n 2 - Neue Linie: GF (Gefaellestrecke)")
(princ "\n 3 - Neue Linie: Ab/Auf VF (VarioFoerderer-Einheit)")
(princ "\n 4 - Neue VF mit horizontalem Anfang (Horizontal-Stueck)")
(princ "\n 5 - Neue Linie BIS Kettenende (danach Separator + ES-Element)")
(setq antwort (getstring "\nIhre Wahl (1-5) [2]: "))
(princ (ssg-text "vfl-menu-gf-bogen-1"))
(princ (ssg-text "vfl-menu-linie-gf-2"))
(princ (ssg-text "vfl-menu-linie-vf-3"))
(princ (ssg-text "vfl-menu-horizontal-vf-4"))
(princ (ssg-text "vfl-menu-linie-ende-5"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-5-def2")))
(setq wahl (cond ((= antwort "1") "GF-Bogen")
((= antwort "3") "Linie-VF")
((= antwort "4") "Horizontal-VF")
@@ -1319,17 +1593,19 @@
(t "Linie-GF"))) ; "2" oder leer
)
(progn
(princ "\n 1 - Neue Linie: GF (Gefaellestrecke)")
(princ "\n 2 - Neue Linie: Ab/Auf VF (VarioFoerderer-Einheit)")
(princ "\n 3 - Neue VF mit horizontalem Anfang (Horizontal-Stueck)")
(princ "\n 4 - Neue Linie BIS Kettenende (danach Separator + ES-Element)")
(setq antwort (getstring "\nIhre Wahl (1-4) [1]: "))
(princ (ssg-text "vfl-menu-linie-gf-1"))
(princ (ssg-text "vfl-menu-linie-vf-2"))
(princ (ssg-text "vfl-menu-horizontal-vf-3"))
(princ (ssg-text "vfl-menu-linie-ende-4"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-4-def1")))
(setq wahl (cond ((= antwort "2") "Linie-VF")
((= antwort "3") "Horizontal-VF")
((= antwort "4") (setq linie-ende-modus t) "Linie")
(t "Linie-GF"))) ; "1" oder leer
)
)
;; Segmenttyp steht fest -> Glied-Label nachtragen (fuer die Edit-Liste).
(vfl-journal-steplabel wahl)
(cond
((= wahl "GF-Bogen")
@@ -1341,7 +1617,7 @@
((= wahl "Horizontal-VF")
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ "\nAbgebrochen.") (exit)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr linie-mess))
(setq kettenanfang (null frame))
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen, reale
@@ -1354,7 +1630,7 @@
)
)
(if (< deltaL 1000.0)
(princ "\nFEHLER: Horizontaler VF braucht >= 1000 mm (Umlenk + Motor) - laenger zeichnen.")
(princ (ssg-text "vfl-fehler-horizontal-vf-kurz"))
(progn
;; VF-Einheit mit horizontalem ersten Koerper (winkel=0, L_VF=deltaL,
;; L_GF = Mindestlaenge fuer den Einlauf-Anschluss).
@@ -1376,12 +1652,12 @@
;; Segment (frame=nil) definiert die Richtung frei.
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ "\nAbgebrochen.") (exit)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr linie-mess))
(setq kettenanfang (null frame))
(setq gf-max-winkel (float (ssg-cfg-or "vario" "gefaelle_winkel" 3)))
(if (< deltaL 1.0)
(princ "\nFEHLER: Linie zu kurz (oder entgegen der Fahrtrichtung) - bitte erneut waehlen.")
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
;; (Richtung hz-neu jetzt bekannt) und die GF-Restlaenge aus dem
@@ -1399,21 +1675,20 @@
)
)
(setq gf-ok t)
(princ "\nGefaelle festlegen:")
(princ "\n 1 - Gegebene Hoehe (Zielhoehe)")
(princ "\n 2 - Neigungswinkel eingeben")
(setq antwort (getstring "\nIhre Wahl (1/2) [1]: "))
(princ (ssg-text "vfl-gefaelle-festlegen-header"))
(princ (ssg-text "vfl-gefaelle-opt-hoehe"))
(princ (ssg-text "vfl-gefaelle-opt-winkel"))
(setq antwort (vfl-in-string (ssg-text "prompt-wahl-1-2")))
(if (= antwort "2")
(progn
;; Winkel direkt vorgeben - deltaH ergibt sich aus deltaL*tan(winkel).
(setq winkel
(getreal (strcat "\nNeigungswinkel (Grad, 0 < Winkel <= "
(rtos gf-max-winkel 2 1) ") [" (rtos gf-max-winkel 2 1) "]: ")))
(vfl-in-real (ssg-textf "vfl-prompt-neigungswinkel" (list (rtos gf-max-winkel 2 1)))))
(if (null winkel) (setq winkel gf-max-winkel))
(if (or (<= winkel 0.0) (> winkel gf-max-winkel))
(progn
(alert (strcat "Neigungswinkel ungueltig: " (rtos winkel 2 1)
" Grad. Erlaubt: 0 < Winkel <= " (rtos gf-max-winkel 2 1) " Grad."))
(alert (ssg-textf "vfl-alert-winkel-ungueltig"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
(progn
(setq richtung "Ab")
@@ -1428,22 +1703,21 @@
;; p-aktuell ist ab hier immer der reale Referenzpunkt (bei
;; Kettenanfang das echte KS_AUS des AS-Elements).
(setq hoehe-neu
(getreal (strcat "\nHoehe (Z) des Linienendpunkts [" (rtos (caddr p-aktuell) 2 1) "]: ")))
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos (caddr p-aktuell) 2 1)))))
(if (null hoehe-neu) (setq hoehe-neu (caddr p-aktuell)))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
(setq deltaH (abs deltaH))
(cond
((= richtung "Auf")
(alert "Gefaellestrecke (GF) kann nicht steigen - bitte tiefere Zielhoehe waehlen oder \"Ab/Auf VF\" benutzen.")
(alert (ssg-text "vfl-alert-gf-kann-nicht-steigen"))
(setq gf-ok nil))
(t
(setq winkel (* (atan (/ deltaH deltaL)) (/ 180.0 pi)))
(if (> winkel gf-max-winkel)
(progn
(alert (strcat "Gefaelle zu steil fuer GF: " (rtos winkel 2 1)
" Grad (erlaubt max " (rtos gf-max-winkel 2 1)
" Grad).\nBitte kleinere Hoehendifferenz waehlen oder \"Ab/Auf VF\" benutzen."))
(alert (ssg-textf "vfl-alert-gefaelle-zu-steil"
(list (rtos winkel 2 1) (rtos gf-max-winkel 2 1))))
(setq gf-ok nil))
)
)
@@ -1457,11 +1731,11 @@
(vfl-acc-gf-seg (/ deltaL (cos (* (float winkel) (/ pi 180.0)))) winkel)
(setq letzter-typ "GF")
(setq p-aktuell (car frame))
(princ "\nIst das das Kettenende?")
(princ "\n 1 - Ja (ES-Element setzen)")
(princ "\n 2 - Ja (ohne ES-Element setzen)")
(princ "\n 3 - Nein (weiterbauen)")
(setq antwort (getstring "\nIhre Wahl (1-3) [3]: "))
(princ (ssg-text "vfl-ist-kettenende-header"))
(princ (ssg-text "vfl-kettenende-opt-ja-es"))
(princ (ssg-text "vfl-kettenende-opt-ja-ohne-es"))
(princ (ssg-text "vfl-kettenende-opt-nein"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-3-def3")))
(cond
((= antwort "1")
(setq es-seite (vfl-frage-es-seite))
@@ -1480,7 +1754,7 @@
((= wahl "Linie-VF")
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ "\nAbgebrochen.") (exit)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr linie-mess))
(setq kettenanfang (null frame))
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen, reale
@@ -1493,10 +1767,10 @@
)
)
(if (< deltaL 1000.0)
(princ "\nFEHLER: VarioFoerderer braucht >= 1000 mm (Umlenk + Motor) - laenger zeichnen oder \"GF\" waehlen.")
(princ (ssg-text "vfl-fehler-vf-kurz"))
(progn
(setq hoehe-neu
(getreal (strcat "\nHoehe (Z) des Linienendpunkts [" (rtos (caddr p-aktuell) 2 1) "]: ")))
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos (caddr p-aktuell) 2 1)))))
(if (null hoehe-neu) (setq hoehe-neu (caddr p-aktuell)))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
@@ -1505,10 +1779,8 @@
(setq typ (nth 0 entscheidung) winkel (nth 1 entscheidung)
L_GF (nth 2 entscheidung) L_VF (nth 3 entscheidung))
(if (null typ)
(alert (strcat "VF-Einheit geometrisch nicht baubar!\n"
"deltaL=" (rtos deltaL 2 0) " mm, deltaH=" (rtos deltaH 2 0)
" mm, Richtung=" richtung
"\nBitte anderen Endpunkt/Hoehe waehlen."))
(alert (ssg-textf "vfl-alert-vf-nicht-baubar"
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(progn
(setq vf-einheit-res
(vfl-vf-einheit-abschluss frame hz-neu richtung winkel L_GF L_VF nil))
@@ -1529,11 +1801,11 @@
;; Segment (frame=nil) definiert die Richtung frei.
(setq linie-mess (vfl-neue-linie-messen p-aktuell
(if frame (car (frame->hz-winkel frame)) nil)))
(if (null linie-mess) (progn (princ "\nAbgebrochen.") (exit)))
(if (null linie-mess) (progn (princ (ssg-text "vfl-abgebrochen")) (exit)))
(setq deltaL (car linie-mess) hz-neu (cadr linie-mess) pick-punkt (caddr linie-mess))
(setq kettenanfang (null frame))
(if (< deltaL 1.0)
(princ "\nFEHLER: Linie zu kurz (oder entgegen der Fahrtrichtung) - bitte erneut waehlen.")
(princ (ssg-text "vfl-fehler-linie-zu-kurz"))
(progn
;; Kettenanfang: AS-Element (falls gewuenscht) SOFORT einfuegen
;; (immer flach, typ-unabhaengig - siehe vfl-insert-as-element;
@@ -1559,13 +1831,12 @@
(setq deltaH (* deltaL (/ (sin (* 3.0 (/ pi 180.0)))
(cos (* 3.0 (/ pi 180.0))))))
(setq hoehe-neu (- (caddr p-aktuell) deltaH))
(princ (strcat "\n>>> Kurzes Segment (deltaL=" (rtos deltaL 2 0)
" mm < 1000): automatisch 3-Grad-Gefaellestrecke"
" (keine Hoehenabfrage, deltaH=" (rtos deltaH 2 1) " mm)."))
(princ (ssg-textf "vfl-info-kurzes-segment"
(list (rtos deltaL 2 0) (rtos deltaH 2 1))))
)
(progn
(setq hoehe-neu
(getreal (strcat "\nHoehe (Z) des Linienendpunkts [" (rtos (caddr p-aktuell) 2 1) "]: ")))
(vfl-in-real (ssg-textf "vfl-prompt-hoehe-linienendpunkt" (list (rtos (caddr p-aktuell) 2 1)))))
(if (null hoehe-neu) (setq hoehe-neu (caddr p-aktuell)))
(setq deltaH (- hoehe-neu (caddr p-aktuell)))
(setq richtung (if (>= deltaH 0.0) "Auf" "Ab"))
@@ -1584,9 +1855,8 @@
(abs (if ein-dx ein-dx 0.0)))))
(setq deltaH (max 0.0 (- deltaH (* 300.0 (sin rad3))
(abs (if ein-dz ein-dz 0.0)))))
(princ (strcat "\n>>> Kettenende-Modus: Footprint fuer Separator + ES"
" reserviert -> baubar deltaL=" (rtos deltaL 2 0)
" mm, deltaH=" (rtos deltaH 2 0) " mm."))
(princ (ssg-textf "vfl-info-kettenende-footprint"
(list (rtos deltaL 2 0) (rtos deltaH 2 0))))
)
)
(setq entscheidung (vfl-segment-entscheidung deltaL deltaH richtung))
@@ -1596,10 +1866,8 @@
)
(if (null typ)
(alert (strcat "Segment geometrisch nicht baubar!\n"
"deltaL=" (rtos deltaL 2 0) " mm, deltaH=" (rtos deltaH 2 0)
" mm, Richtung=" richtung
"\nBitte anderen Endpunkt/Hoehe waehlen."))
(alert (ssg-textf "vfl-alert-segment-nicht-baubar"
(list (rtos deltaL 2 0) (rtos deltaH 2 0) richtung)))
(progn
(if (= typ "GF")
(progn
@@ -1615,11 +1883,11 @@
(if linie-ende-modus
(setq antwort "1")
(progn
(princ "\nIst das das Kettenende?")
(princ "\n 1 - Ja (ES-Element setzen)")
(princ "\n 2 - Ja (ohne ES-Element setzen)")
(princ "\n 3 - Nein (weiterbauen)")
(setq antwort (getstring "\nIhre Wahl (1-3) [3]: "))
(princ (ssg-text "vfl-ist-kettenende-header"))
(princ (ssg-text "vfl-kettenende-opt-ja-es"))
(princ (ssg-text "vfl-kettenende-opt-ja-ohne-es"))
(princ (ssg-text "vfl-kettenende-opt-nein"))
(setq antwort (vfl-in-string (ssg-text "vfl-prompt-wahl-1-3-def3")))
)
)
(cond
@@ -1655,16 +1923,73 @@
(setq hoehe-bis (caddr (car frame)))
;; DELTA_L: planare Gesamtdistanz Start -> Kettenende
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite
startpunkt lastEnt)
(setq vfl-ins
(vfl-block-erstellen vfl-nummer anzahl-gf anzahl-vf (caddr startpunkt) hoehe-bis
(vfl-planar-dist startpunkt (car frame)) as-seite es-seite
startpunkt lastEnt))
;; Eingabe-Journal am fertigen Block persistieren (Marker "linienzug" +
;; Chunks) -> spaeter per Doppelklick editierbar (vfl-edit-ent).
(if vfl-ins (vfl-journal-xdata-schreiben vfl-ins))
;; Erfolgreicher Abschluss: *error* zuruecksetzen, evtl. offenes Abbruch-
;; Journal verwerfen (die Kette ist fertiggestellt), Editier-Marker loeschen
;; (der Original-Block bleibt im Edit-Fall geloescht - der Neuaufbau ersetzt ihn).
(setq *error* old-error)
(setq *vfl-journal-letzter-abbruch* nil)
(setq *vfl-edit-orig-ent* nil)
(princ "\n\n=========================================")
(princ "\n>>> VF-Linienzug-Kette eingefuegt! <<<")
(princ (ssg-text "vfl-kette-eingefuegt"))
(princ "\n=========================================")
(princ)
)
;; ============================================================
;; EDITIEREN: gliedweise zuruecknehmen + Neuaufbau per Replay
;; ============================================================
;; Aufgerufen aus c:VARIOFOERDERER_EDIT (Doppelklick auf VF_n mit XDATA-Marker
;; "linienzug"). Liest das Eingabe-Journal vom Block, listet die Glieder, laesst
;; k Glieder vom Ende zuruecknehmen, loescht den alten Block und baut die Kette
;; neu: die behaltenen Glieder werden stumm abgespielt, danach laeuft die
;; Eingabe interaktiv fuer die geaenderten/neuen Glieder weiter.
(defun vfl-edit-ent (ent / journal glieder n i k trunc)
(setq journal (vfl-journal-xdata-lesen ent))
(if (null journal)
(progn (alert (ssg-text "vfl-edit-kein-journal")) (exit)))
(setq glieder (vfl-journal-glieder journal))
(setq n (length glieder))
(princ (ssg-textf "vfl-edit-kette-header" (list (itoa n))))
(setq i 1)
(foreach g glieder
(princ (strcat "\n " (itoa i) ") " (vfl-glied-label-text g)))
(setq i (1+ i)))
(setq k (getint (ssg-textf "vfl-edit-wieviele" (list (itoa n)))))
(if (or (null k) (< k 0)) (setq k 0))
(if (> k n) (setq k n))
(setq trunc (vfl-journal-truncate journal (- n k)))
;; Alten Block entfernen (wie Standard/Etage: entdel + kompletter Neuaufbau).
;; *vfl-edit-orig-ent* merken, damit ein Abbruch waehrend des Neuaufbaus den
;; Original-Block wiederherstellen kann (vfl-modus-cleanup).
(setq *vfl-edit-orig-ent* ent)
(entdel ent)
(princ (ssg-textf "vfl-edit-abgespielt" (list (itoa (- n k)) (itoa k))))
;; Behaltene Glieder abspielen, dann live weiterbauen.
(vfl-journal-replay-start trunc)
(vf-linienzug-modus)
(princ))
;; Wiederaufnahme des zuletzt abgebrochenen Linienzugs: das beim Abbruch
;; gesicherte Journal abspielen und danach interaktiv weiterbauen.
(defun vfl-modus-fortsetzen ( / )
(if (and (boundp '*vfl-journal-letzter-abbruch*) *vfl-journal-letzter-abbruch*)
(progn
(princ (ssg-text "vfl-fortsetzen-start"))
(setq *vfl-edit-orig-ent* nil) ; Wiederaufnahme ist kein Edit -> kein Original restaurieren
(vfl-journal-replay-start *vfl-journal-letzter-abbruch*)
(vf-linienzug-modus))
(progn
(princ (ssg-text "vfl-fortsetzen-keiner"))
(princ))))
;; ============================================================
;; DIAGNOSE: Blockstruktur (KS_EIN/KS_AUS) untersuchen
;; ============================================================