Die Funktion bei VF_Linienzug wurde optimiert. Und TEST_LINIENZUG wurde in test_foerdererer.lsp eingebaut.

This commit is contained in:
2026-07-08 13:45:12 +02:00
parent 80ec7043b8
commit 3897581dc9
9 changed files with 692 additions and 116 deletions
+157 -2
View File
@@ -105,8 +105,10 @@
startpunkt hoehe-von hoehe-bis lastEnt
sub-typ)
;; Bibliothek initialisieren (laedt Block-Library und extrahiert Masse)
(if (not *lib-initialized*)
;; Bibliothek initialisieren (laedt Block-Library und extrahiert Masse).
;; Auch bei gesetztem Flag, aber leerer Bogen-Tabelle neu initialisieren
;; (Selbstheilung gegen Stuck-State).
(if (or (not *lib-initialized*) (null bogen-auf))
(init-bibliothek)
)
@@ -274,3 +276,156 @@
(princ "\n================================================================")
(princ)
)
;; ============================================================
;; C:TEST_LINIENZUG - Regressionstest fuer den VF-Linienzug (Modus 1)
;; ------------------------------------------------------------
;; EIGENSTAENDIG: beruehrt weder c:TEST_FOERDERER noch dessen Funktionen.
;; ============================================================
;; Der VF-Linienzug (vf-linienzug-modus) ist stark interaktiv (getpoint /
;; getstring / getint / getreal). Dieser Test spielt eine reale Session als
;; Skript ab: die vier Eingabe-Funktionen werden NUR waehrend des Testlaufs
;; durch Mocks ersetzt (mit Save/Restore), danach wieder hergestellt.
;;
;; Repliziertes Szenario (aus manuellem Test):
;; Start Z=4500, AS rechts
;; -> Neue Linie (Ab, Ziel-Z=1800, Winkel 45 Grad), GF ganz am Einlauf
;; -> Horizontal 900 mm mit Separator VOR + NACH (beide horizontal, 0 Grad)
;; -> Vario-Kurve 90 links aussen
;; -> Horizontal 250 mm (ohne Separatoren)
;; -> Vario-Kurve 90 links aussen
;; -> Option 3 (Kettenende definieren): Ziel-Z=4500, Winkel 45 Grad, ES rechts
;;
;; Erwartetes Ergebnis (Ist-Ziel-Report):
;; dX ~ 0, dZ ~ 0 (Ziel exakt getroffen),
;; dY ~ 637 mm = seitlicher Fussabdruck des ES_Element_90 (90-Grad-Schwenk;
;; KEIN Baufehler, sondern die Bauform des ES-Elements).
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_foerderer.lsp"))
;; TEST_LINIENZUG
;; ============================================================
;; Naechste Skript-Antwort liefern (FIFO). Bei leerer Queue Warnung + "".
(defun tlz-pop ( / v)
(if *tlz-q*
(progn (setq v (car *tlz-q*)) (setq *tlz-q* (cdr *tlz-q*)) v)
(progn (princ "\n [TEST_LINIENZUG] WARNUNG: Skript-Queue leer - unerwartete Abfrage!") "")
)
)
;; Mock-Eingabefunktionen. getpoint erhaelt als 1. Argument den Basispunkt
;; (p-akt) bei Folge-Segmenten bzw. einen Prompt-String beim Startpunkt.
;; Skript-Eintrag (A x y z) -> absoluter Punkt
;; Skript-Eintrag (P dL hz) -> Basispunkt + dL entlang Richtung hz (Grad),
;; sodass die Projektion in vfl-neue-linie-messen
;; exakt dL ergibt.
(defun tlz-getpoint (a b / spec base rad)
(setq spec (tlz-pop))
(setq base (if (and a (listp a)) a '(0.0 0.0 0.0)))
(if (and (listp spec) (= (car spec) 'A))
(list (float (cadr spec)) (float (caddr spec)) (float (cadddr spec)))
(progn
(setq rad (* (float (caddr spec)) (/ pi 180.0)))
(list (+ (car base) (* (float (cadr spec)) (cos rad)))
(+ (cadr base) (* (float (cadr spec)) (sin rad)))
(caddr base))
)
)
)
(defun tlz-getstring (a) (tlz-pop))
(defun tlz-getint (a) (tlz-pop))
(defun tlz-getreal (a) (tlz-pop))
(defun c:TEST_LINIENZUG ( / old-vgp old-gs old-gi old-gr err)
(if (or (not *lib-initialized*) (null bogen-auf)) (init-bibliothek))
(if (null (car (atoms-family 1 '("VF-LINIENZUG-MODUS"))))
(progn
(alert (strcat "vf-linienzug-modus nicht geladen!\n"
"Bitte Menue/Module laden (VarioFoerderer + Gefaellestrecke)."))
(exit)
)
)
(princ "\n================================================================")
(princ "\n TEST_LINIENZUG - VF-Linienzug Replay-Test")
(princ "\n================================================================")
(ssg-start "TEST_LINIENZUG" '(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; --- Skript der Eingaben in exakter Aufruf-Reihenfolge ---
(setq *tlz-q*
(list
(list 'A 0 0 0) ; getpoint Startpunkt der Kette
4500.0 ; getreal Hoehe (Z) Startpunkt
"2" ; getstring AS-Seite (rechts)
"1" ; getstring Naechstes Element (Neue Linie)
(list 'P 5500 0) ; getpoint Endpunkt Linie (frei, +X, dL=5500)
1800.0 ; getreal Hoehe (Z) Linienendpunkt
1 ; getint Winkelwahl (45 Grad)
"2" ; getstring GF-Verteilung (alles am Einlauf)
"2" ; getstring Ist Endpunkt? (Nein)
"1" ; getstring Naechstes im VF (Horizontal)
(list 'P 900 0) ; getpoint Horizontal-Endpunkt (dL=900, hz=0)
"1" ; getstring Separator VOR? (Ja)
"1" ; getstring Separator NACH? (Ja)
"2" ; getstring Ist Endpunkt? (Nein)
"2" ; getstring Naechstes (Vario-Kurve)
1 ; getint Kurve-Winkel (90)
"1" ; getstring Kurve-Seite (links)
"1" ; getstring Kurve-Variante (aussen)
"2" ; getstring Ist Endpunkt? (Nein)
"1" ; getstring Naechstes (Horizontal)
(list 'P 250 90) ; getpoint Horizontal-Endpunkt (dL=250, hz=90)
"2" ; getstring Separator VOR? (Nein)
"2" ; getstring Separator NACH? (Nein)
"2" ; getstring Ist Endpunkt? (Nein)
"2" ; getstring Naechstes (Vario-Kurve)
1 ; getint Kurve-Winkel (90)
"1" ; getstring Kurve-Seite (links)
"1" ; getstring Kurve-Variante (aussen)
"3" ; getstring Ist Endpunkt? (Option 3 - Kettenende)
(list 'P 6215 180) ; getpoint Option-3-Endpunkt (dL=6215, hz=180)
4500.0 ; getreal Hoehe (Z) Kettenende (ES)
2 ; getint Option-3-Winkelwahl (45 Grad)
"2" ; getstring ES-Seite (rechts)
)
)
;; --- Eingabe-Funktionen sichern und durch Mocks ersetzen ---
;; Punkte ueber den Produktions-Wrapper vfl-getpoint (feste 2-Arity),
;; getstring/getint/getreal (alle 1-argumentig) direkt.
(setq old-vgp vfl-getpoint old-gs getstring old-gi getint old-gr getreal)
(setq vfl-getpoint tlz-getpoint
getstring tlz-getstring
getint tlz-getint
getreal tlz-getreal)
;; --- Linienzug-Modus abspielen (Fehler abfangen, damit Restore sicher laeuft) ---
(setq err (vl-catch-all-apply 'vf-linienzug-modus '()))
;; --- Eingabe-Funktionen wiederherstellen (IMMER) ---
(setq vfl-getpoint old-vgp getstring old-gs getint old-gi getreal old-gr)
(princ "\n================================================================")
(if (vl-catch-all-error-p err)
(princ (strcat "\n TEST_LINIENZUG: FEHLER -> "
(vl-catch-all-error-message err)))
(progn
(princ "\n TEST_LINIENZUG: Kette gebaut.")
(if *tlz-q*
(princ (strcat "\n WARNUNG: " (itoa (length *tlz-q*))
" Skript-Eintraege NICHT verbraucht (Ablauf weicht ab)."))
(princ "\n Alle Skript-Eingaben verbraucht (Ablauf wie erwartet)."))
(princ "\n Erwartung Ist-Ziel: dX~0, dZ~0, dY~637 mm (ES_90-Seitenversatz).")
)
)
(princ "\n================================================================")
(ssg-end)
(princ)
)
+88 -23
View File
@@ -78,7 +78,7 @@
;; as-seite : "links" oder "rechts" (AUS-Element)
;; es-seite : "links" oder "rechts" (EIN-Element)
;; Rueckgabe : GF_N INSERT ename oder nil bei Fehler
(defun gefaellestrecke:modus3-einfuegen (linie-vla startpunkt endpunkt-ref as-seite es-seite /
(defun gefaellestrecke:modus3-einfuegen (objekt-liste startpunkt endpunkt-ref as-seite es-seite /
as-block es-block deltaH
kette segmente seg
entry-hz exit-hz grade
@@ -98,8 +98,8 @@
(setq es-block (strcat "ES_Element_90_" es-seite))
(setq deltaH (abs (- (caddr startpunkt) (caddr endpunkt-ref))))
;; 1. Kette sortieren und analysieren
(setq kette (gf-sortiere-objekte (list linie-vla) startpunkt))
;; 1. Kette sortieren und analysieren (objekt-liste = 1..n LINE/ARC-Objekte)
(setq kette (gf-sortiere-objekte objekt-liste startpunkt))
(if (null kette)
;; Fehler: keine Kette -> nil zurueckgeben
(progn (princ "\n FEHLER: keine sortierte Kette!") nil)
@@ -278,7 +278,8 @@
bL90 bL60 bL30
bR90 bR60 bR30
startpunkt last-ent nach-aus-pt entry-hz
(caddr (nth first-idx segmente))))
(caddr (nth first-idx segmente))
es-seite))
gf-ins
)
)
@@ -294,6 +295,7 @@
gf-ins ergebnis attribs h-von h-bis d-h w-str
m2-start m2-deltaH m2-deltaL
m3-start m3-end m3-line-vla
m3b-start m3b-end m3b-e1 m3b-e2 m3b-e3 m3b-objliste
lbl-layer lbl-h lbl-h2)
;; Block-Bibliothek initialisieren (setzt aus-dx, ein-dx, aus-dz, ein-dz usw.)
@@ -378,10 +380,10 @@
(if gf-ins
(progn
(setq attribs (ssg-attrib-read gf-ins))
(setq h-von (atoi (cdr (assoc "HOEHE_VON" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs))))
(setq h-von (atoi (cdr (assoc "HOEHE_VON_mm" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS_mm" attribs))))
(setq d-h (abs (- h-von h-bis)))
(setq w-str (cdr (assoc "WINKEL" attribs)))
(setq w-str (cdr (assoc "GF_WINKEL" attribs)))
(princ (strcat " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
@@ -410,10 +412,10 @@
(if gf-ins
(progn
(setq attribs (ssg-attrib-read gf-ins))
(setq h-von (atoi (cdr (assoc "HOEHE_VON" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs))))
(setq h-von (atoi (cdr (assoc "HOEHE_VON_mm" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS_mm" attribs))))
(setq d-h (abs (- h-von h-bis)))
(setq w-str (cdr (assoc "WINKEL" attribs)))
(setq w-str (cdr (assoc "GF_WINKEL" attribs)))
(princ (strcat " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
@@ -442,10 +444,10 @@
(if gf-ins
(progn
(setq attribs (ssg-attrib-read gf-ins))
(setq h-von (atoi (cdr (assoc "HOEHE_VON" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs))))
(setq h-von (atoi (cdr (assoc "HOEHE_VON_mm" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS_mm" attribs))))
(setq d-h (abs (- h-von h-bis)))
(setq w-str (cdr (assoc "WINKEL" attribs)))
(setq w-str (cdr (assoc "GF_WINKEL" attribs)))
(princ (strcat " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
@@ -474,10 +476,10 @@
(if gf-ins
(progn
(setq attribs (ssg-attrib-read gf-ins))
(setq h-von (atoi (cdr (assoc "HOEHE_VON" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs))))
(setq h-von (atoi (cdr (assoc "HOEHE_VON_mm" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS_mm" attribs))))
(setq d-h (abs (- h-von h-bis)))
(setq w-str (cdr (assoc "WINKEL" attribs)))
(setq w-str (cdr (assoc "GF_WINKEL" attribs)))
(princ (strcat " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
@@ -525,14 +527,14 @@
(if gf-ins
(progn
(setq attribs (ssg-attrib-read gf-ins))
(setq h-von (atoi (cdr (assoc "HOEHE_VON" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs))))
(setq h-von (atoi (cdr (assoc "HOEHE_VON_mm" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS_mm" attribs))))
;; Volle Fliesskomma-Genauigkeit direkt aus der Rueckgabe verwenden
;; (nicht aus den auf ganze mm gerundeten HOEHE_VON/HOEHE_BIS-Attributen),
;; damit Modus 3 exakt mit diesen Werten weiterrechnen kann.
(setq m2-deltaH (cadr ergebnis))
(setq m2-deltaL (caddr ergebnis))
(setq w-str (cdr (assoc "WINKEL" attribs)))
(setq w-str (cdr (assoc "GF_WINKEL" attribs)))
(princ (strcat " von=" (itoa h-von) " bis=" (itoa h-bis)
" " delta-sym "H=" (rtos m2-deltaH 2 3)
" mm " delta-sym "L=" (rtos m2-deltaL 2 3)
@@ -601,14 +603,14 @@
(setq m3-line-vla (vlax-ename->vla-object (entlast)))
(setq gf-ins
(gefaellestrecke:modus3-einfuegen
m3-line-vla m3-start m3-end "links" "links"))
(list m3-line-vla) m3-start m3-end "links" "links"))
(if gf-ins
(progn
(setq attribs (ssg-attrib-read gf-ins))
(setq h-von (atoi (cdr (assoc "HOEHE_VON" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs))))
(setq h-von (atoi (cdr (assoc "HOEHE_VON_mm" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS_mm" attribs))))
(setq d-h (abs (- h-von h-bis)))
(setq w-str (cdr (assoc "WINKEL" attribs)))
(setq w-str (cdr (assoc "GF_WINKEL" attribs)))
(princ (strcat "\n -> von=" (itoa h-von) " bis=" (itoa h-bis)
" " delta-sym "H=" (itoa d-h) " mm"
" " delta-sym "H-Soll=" (rtos m2-deltaH 2 3) " mm"
@@ -632,6 +634,69 @@
0.0 0 0 0 "FEHLER_LINIE")
results-list))))
;; ============================================================
;; MODUS 3 - Linienzug MIT Bogen (Linie + 90-Grad-Bogen R500 + Linie)
;; Start Hoehe 2000, waagerecht +X 8000 mm (links->rechts), dann
;; 90-Grad-Bogen R500 (Auslauf Richtung +Y), dann +Y 6000 mm,
;; Endpunkt Hoehe 1800 (dH = 200 mm ueber den ganzen Weg).
;; ============================================================
(princ "\n\n================================================================")
(princ "\n MODUS 3 - Linienzug mit Bogen (8000 +X / 90 Grad R500 / 6000 +Y)")
(princ "\n================================================================")
(setq m3b-start (list 30000.0 -50000.0 2000.0)) ; Kettenanfang, Hoehe 2000
(setq m3b-end (list 38500.0 -43500.0 1800.0)) ; Kettenende, Hoehe 1800
;; Abschnitts-Ueberschrift in der Zeichnung
(entmake (list '(0 . "TEXT")
(cons 10 (list 30000 -52000.0 2000.0))
(cons 11 (list 30000 -52000.0 2000.0))
(cons 40 lbl-h2)
(cons 1 "MODUS 3 - Linienzug mit 90 Grad-Bogen R500")
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 0) '(73 . 2)))
;; Geometrie: LINE (+X 8000) + ARC (90 Grad R500, links) + LINE (+Y 6000).
;; ARC: Mittelpunkt (38000,-49500), Start 270 Grad -> Ende 360 Grad = 90 Grad
;; gegen den Uhrzeigersinn (Linkskurve, +X -> +Y).
(entmake (list '(0 . "LINE")
(cons 10 (list 30000.0 -50000.0 2000.0))
(cons 11 (list 38000.0 -50000.0 2000.0)) (cons 8 lbl-layer)))
(setq m3b-e1 (entlast))
(entmake (list '(0 . "ARC")
(cons 10 (list 38000.0 -49500.0 2000.0))
(cons 40 500.0)
(cons 50 (* 1.5 pi))
(cons 51 (* 2.0 pi)) (cons 8 lbl-layer)))
(setq m3b-e2 (entlast))
(entmake (list '(0 . "LINE")
(cons 10 (list 38500.0 -49500.0 2000.0))
(cons 11 (list 38500.0 -43500.0 2000.0)) (cons 8 lbl-layer)))
(setq m3b-e3 (entlast))
(setq m3b-objliste (list (vlax-ename->vla-object m3b-e1)
(vlax-ename->vla-object m3b-e2)
(vlax-ename->vla-object m3b-e3)))
(setq gf-ins
(gefaellestrecke:modus3-einfuegen m3b-objliste m3b-start m3b-end "links" "links"))
(if gf-ins
(progn
(setq attribs (ssg-attrib-read gf-ins))
(setq h-von (atoi (cdr (assoc "HOEHE_VON_mm" attribs))))
(setq h-bis (atoi (cdr (assoc "HOEHE_BIS_mm" attribs))))
(setq d-h (abs (- h-von h-bis)))
(setq w-str (cdr (assoc "GF_WINKEL" attribs)))
(princ (strcat "\n -> von=" (itoa h-von) " bis=" (itoa h-bis)
" " delta-sym "H=" (itoa d-h) " mm"
" " delta-sym "H-Soll=200 mm W=" w-str " OK"))
(setq results-list
(cons (gefaellestrecke:test-json "M3_Bogen" 3 0.0 14785.0
(atof w-str) h-von h-bis d-h "GEBAUT")
results-list)))
(progn
(princ "\n -> FEHLER (modus3-einfuegen mit Bogen)")
(setq results-list
(cons (gefaellestrecke:test-json "M3_Bogen" 3 0.0 14785.0
0.0 0 0 0 "FEHLER")
results-list))))
;; ============================================================
;; Zusammenfassung und Export
;; ============================================================
+10
View File
@@ -55,5 +55,15 @@
"deltaL_quelle": "M2_hz000",
"as_seite": "links",
"es_seite": "links"
},
{
"test_id": "M3_Bogen",
"modus": 3,
"beschreibung": "Linienzug mit 90-Grad-Bogen R500 (8000 +X / Bogen links / 6000 +Y)",
"start_mm": [30000, -50000, 2000],
"ende_mm": [38500, -43500, 1800],
"bogen": {"winkel_grad": 90, "radius_mm": 500, "seite": "links"},
"as_seite": "links",
"es_seite": "links"
}
]