Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
dxfmakros/tests/test_gefaellestrecke.lsp
T

722 lines
31 KiB
Common Lisp
Raw Permalink Blame History

;; ============================================================
;; test_gefaellestrecke.lsp - Automatischer Integrationstest GEFAELLESTRECKE
;;
;; Modus 1: 4 Richtungen (hz=0/90/180/270 Grad)
;; deltaL=10000 mm, Winkel=3 Grad, Seite links/links
;;
;; Modus 2: Linie entlang X-Achse (hz=0 Grad, Y=-35000)
;; Startpunkt am Linienanfang, Winkel=3 Grad
;;
;; Modus 3: 3D-Linie entlang Y-Achse Richtung Sued (Y=-50000 bis Y=-60000)
;; DeltaH stammt aus Modus 2 Ergebnis
;; Naeherungswinkel + 2-Pass-Korrektur (wie gf-linienzug-modus)
;;
;; Speichert:
;; tests/output/gefaellestrecke_results.json
;;
;; Voraussetzungen:
;; - SSG_LIB geladen (Gefaellestrecke.lsp, ssg_core.lsp, vf_core.lsp)
;; - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_gefaellestrecke.lsp"))
;; TEST_GEFAELLESTRECKE
;; ============================================================
;; --- Ergebnis eines Testfalls als JSON-String erzeugen ---
(defun gefaellestrecke:test-json (test-id modus hz deltaL winkel h-von h-bis d-h status /
json)
(setq json
(strcat " {\n"
" \"test_id\": \"" test-id "\",\n"
" \"modus\": " (itoa modus) ",\n"
" \"hz_grad\": " (rtos (float hz) 2 1) ",\n"
" \"deltaL_mm\": " (rtos (float deltaL) 2 0) ",\n"
" \"winkel_grad\": " (rtos (float winkel) 2 3) ",\n"
" \"hoehe_von_mm\": " (rtos (float h-von) 2 0) ",\n"
" \"hoehe_bis_mm\": " (rtos (float h-bis) 2 0) ",\n"
" \"delta_h_mm\": " (rtos (float d-h) 2 0) ",\n"
" \"status\": \"" status "\"\n"
" }"))
json
)
;; --- JSON-Export der Gefaellestrecke-Testergebnisse ---
(defun gefaellestrecke:export-results (tests-out-dir / out-json f first)
(if (null *gefaellestrecke-test-results*)
(princ "\n Keine Gefaellestrecke-Ergebnisse vorhanden.")
(progn
(vl-mkdir tests-out-dir)
(setq out-json (strcat tests-out-dir "/gefaellestrecke_results.json"))
(setq f (open out-json "w"))
(if f
(progn
(write-line "[" f)
(setq first T)
(foreach r *gefaellestrecke-test-results*
(if (not first) (write-line "," f))
(write-line r f)
(setq first nil))
(write-line "]" f)
(close f)
(princ (strcat "\n Ergebnisse: " out-json)))
(princ (strcat "\n FEHLER: " out-json " nicht schreibbar!"))
)
)
)
)
;; --- Modus 3: Linienzug-basierte Einfuegung (nicht-interaktiv) ---
;; Repliziert gf-linienzug-modus ohne Benutzerabfragen.
;;
;; linie-vla : VLA-Objekt der Leitlinie (LINE oder ARC-Kette)
;; startpunkt : 3D-Punkt KS_EIN des AUS-Elements (hoeher liegende Seite)
;; endpunkt-ref: 3D-Zielhoehe fuer KS_AUS des EIN-Elements
;; 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 (objekt-liste startpunkt endpunkt-ref as-seite es-seite /
as-block es-block deltaH
kette segmente seg
entry-hz exit-hz grade
first-idx last-idx i j neu-l
gf-nummer last-ent
aktuell-frame nach-aus-pt
ein-hz-as rad-h-as rad-v-as xu-entry
sep-endpunkt rad-h-es rad-v-es xu-exit sep-frame
es-aus-frame
delta-l-gf L-gf-str laengen-liste first-l l-item
bL90 bL60 bL30 bR90 bR60 bR30 n-bogen-gf
rad-v-korr ein-hz-as-k rad-h-as-k xu-as-meas
rad-h-es-k xu-es-meas dz-as-ist dz-es-ist
dH-korr grade-korr gf-ins)
(setq as-block (strcat "AS_Element_90_" as-seite))
(setq es-block (strcat "ES_Element_90_" es-seite))
(setq deltaH (abs (- (caddr startpunkt) (caddr endpunkt-ref))))
;; 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)
;; Kette vorhanden: vollstaendige Verarbeitung
(progn
(setq segmente (gf-analysiere-kette kette))
;; 2. Eingangs-/Ausgangsrichtung
(setq entry-hz (cadr (car segmente)))
(setq exit-hz (gf-exit-hz segmente))
;; 3. Segmentlaengen anpassen (erste Linie -aus-dx, letzte -300-ein-dx)
(setq first-idx -1 j 0)
(while (and (< j (length segmente)) (< first-idx 0))
(if (= (car (nth j segmente)) "Linie") (setq first-idx j))
(setq j (1+ j)))
(setq last-idx -1 j (1- (length segmente)))
(while (and (>= j 0) (< last-idx 0))
(if (= (car (nth j segmente)) "Linie") (setq last-idx j))
(setq j (1- j)))
(if (>= first-idx 0)
(progn
(setq i 0)
(while (< i (length segmente))
(setq seg (nth i segmente))
(if (= (car seg) "Linie")
(progn
(setq neu-l (caddr seg))
(if (= i first-idx)
(setq neu-l (- neu-l aus-dx)))
(if (and (< (1+ i) (length segmente))
(= (car (nth (1+ i) segmente)) "Bogen"))
(setq neu-l (- neu-l 300.0)))
(if (= i last-idx)
(setq neu-l (- neu-l 300.0 ein-dx)))
(setq neu-l (max 100.0 neu-l))
(setq segmente
(gf-replace-nth segmente i
(list (car seg) (cadr seg) neu-l (nth 3 seg) (nth 4 seg))))))
(setq i (1+ i)))))
;; 4. Gefaellewinkel berechnen (Naeherung)
(princ (strcat "\n dH=" (rtos deltaH 2 2) " mm"
" entry-hz=" (rtos entry-hz 2 1) " Grad"
" exit-hz=" (rtos exit-hz 2 1) " Grad"))
(setq grade (gf-winkel-berechnen segmente deltaH 1))
;; 5. Winkelkorrektur: tatsaechliche AS/ES-Absenkung messen
(if (and *gf-L-ohne-as-es* (> *gf-L-ohne-as-es* 0.1))
(progn
(setq rad-v-korr (* grade (/ pi 180.0)))
(setq ein-hz-as-k
(if (= as-seite "rechts") (+ entry-hz 90.0) (- entry-hz 90.0)))
(setq rad-h-as-k (* (float ein-hz-as-k) (/ pi 180.0)))
(setq xu-as-meas
(list (* (cos rad-h-as-k)(cos rad-v-korr))
(* (sin rad-h-as-k)(cos rad-v-korr))
(- (sin rad-v-korr))))
(setq rad-h-es-k (* (float exit-hz) (/ pi 180.0)))
(setq xu-es-meas
(list (* (cos rad-h-es-k)(cos rad-v-korr))
(* (sin rad-h-es-k)(cos rad-v-korr))
(- (sin rad-v-korr))))
(setq dz-as-ist (gf-messe-dz-block as-block xu-as-meas))
(setq dz-es-ist (gf-messe-dz-block es-block xu-es-meas))
(princ (strcat "\n AS-dz=" (rtos dz-as-ist 2 2)
" ES-dz=" (rtos dz-es-ist 2 2) " mm"))
(setq dH-korr
(- (float deltaH) dz-as-ist dz-es-ist (float *gf-sum-dz-bogen*)))
(if (and (> dH-korr 0.0) (< (/ dH-korr *gf-L-ohne-as-es*) 1.0))
(progn
(setq grade-korr
(* (asin (/ dH-korr *gf-L-ohne-as-es*)) (/ 180.0 pi)))
(princ (strcat "\n>>> Korrigierter Winkel: "
(rtos grade-korr 2 3) " Grad"))
(setq grade grade-korr))
(princ "\n WARNUNG: Korrektur ausserhalb Bereich"))))
;; 6. Horizontaldistanz Start->Ende fuer DELTA_L-Attribut
(setq delta-l-gf
(sqrt (+ (expt (- (car endpunkt-ref) (car startpunkt)) 2)
(expt (- (cadr endpunkt-ref) (cadr startpunkt)) 2))))
;; 7. GF-Nummer und Entity-Grenze vor erster Einfuegung
(setq gf-nummer (gf-next-number))
(setq last-ent (vf-lastent-ohne-attribute))
;; 8. AUS-Element einfuegen
;; KS_EIN-Richtung so, dass KS_AUS in entry-hz zeigt:
;; links: KS_EIN = entry-hz - 90 Grad
;; rechts: KS_EIN = entry-hz + 90 Grad
(setq ein-hz-as
(if (= as-seite "rechts") (+ entry-hz 90.0) (- entry-hz 90.0)))
(setq rad-h-as (* (float ein-hz-as) (/ pi 180.0)))
(setq rad-v-as (* (float grade) (/ pi 180.0)))
(setq xu-entry
(list (* (cos rad-h-as)(cos rad-v-as))
(* (sin rad-h-as)(cos rad-v-as))
(- (sin rad-v-as))))
(princ (strcat "\n>>> AUS: " as-block
" KS_EIN-hz=" (rtos ein-hz-as 2 1) " Grad"))
;; Block-Ursprung (nicht KS_EIN) in X/Y auf startpunkt, damit die Mittelachse
;; durch startpunkt verlaeuft; Z-Hoehe weiterhin an KS_EIN gemessen
;; (siehe gf-linienzug-modus).
(setq aktuell-frame
(insert-block-mixed-to-ks as-block (make-frame-from-dir startpunkt xu-entry)
(caddr startpunkt) nil "KS_EIN"))
(setq nach-aus-pt (car aktuell-frame))
;; 9. Linienzug (Staustrecken + Gefaellebogen) einfuegen
(setq aktuell-frame (gf-linienzug-einfuegen segmente grade aktuell-frame))
;; 10. Separator vor EIN-Element
(setq sep-endpunkt
(gf-insert-hz-with-ks
"Staustrecke_Separator_SP_300_mm"
(car aktuell-frame) exit-hz grade 300 0))
(setq rad-h-es (* (float exit-hz) (/ pi 180.0)))
(setq rad-v-es (* (float grade) (/ pi 180.0)))
(setq xu-exit
(list (* (cos rad-h-es)(cos rad-v-es))
(* (sin rad-h-es)(cos rad-v-es))
(- (sin rad-v-es))))
(setq sep-frame (make-frame-from-dir sep-endpunkt xu-exit))
;; 11. EIN-Element einfuegen
;; KS_EIN bleibt in X/Y auf sep-frame (Ketten-Pfad); Z-Hoehe wird an
;; KS_AUS gemessen, damit KS_AUS.Z exakt auf endpunkt-ref.Z landet.
(princ (strcat "\n>>> ES: " es-block
" Ziel-Z=" (rtos (caddr endpunkt-ref) 2 1)))
(setq es-aus-frame
(insert-block-mixed-to-ks es-block sep-frame
(caddr endpunkt-ref) "KS_EIN" "KS_AUS"))
(princ (strcat "\n Z-Hoehe KS_AUS: " (rtos (caddr (car es-aus-frame)) 2 1) " mm"))
;; 12. L_GF_m-String: Segmentlaengen in Metern (kommagetrennt)
(setq laengen-liste '() first-l t)
(foreach seg segmente
(if (= (car seg) "Linie")
(setq laengen-liste
(append laengen-liste
(list (rtos (/ (caddr seg) 1000.0) 2 3))))))
(setq L-gf-str "")
(foreach l-item laengen-liste
(if first-l
(progn (setq L-gf-str l-item) (setq first-l nil))
(setq L-gf-str (strcat L-gf-str "," l-item))))
;; 13. Bogen-Typen zaehlen
(setq bL90 0 bL60 0 bL30 0 bR90 0 bR60 0 bR30 0)
(foreach seg segmente
(if (= (car seg) "Bogen")
(cond
((and (= (nth 4 seg) "links") (= (nth 3 seg) 90)) (setq bL90 (1+ bL90)))
((and (= (nth 4 seg) "links") (= (nth 3 seg) 60)) (setq bL60 (1+ bL60)))
((and (= (nth 4 seg) "links") (= (nth 3 seg) 30)) (setq bL30 (1+ bL30)))
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 90)) (setq bR90 (1+ bR90)))
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 60)) (setq bR60 (1+ bR60)))
((and (= (nth 4 seg) "rechts") (= (nth 3 seg) 30)) (setq bR30 (1+ bR30))))))
(setq n-bogen-gf (+ bL90 bL60 bL30 bR90 bR60 bR30))
;; 14. GF_N-Block mit Attributen erstellen und Ename zurueckgeben
(setq gf-ins
(gf-block-erstellen
"gruppe" as-seite gf-nummer
(caddr startpunkt)
(caddr endpunkt-ref)
deltaH
delta-l-gf
L-gf-str
grade
(1+ n-bogen-gf)
0
bL90 bL60 bL30
bR90 bR60 bR30
startpunkt last-ent nach-aus-pt entry-hz
(caddr (nth first-idx segmente))
es-seite))
gf-ins
)
)
)
;; ============================================================
;; C:TEST_GEFAELLESTRECKE - Hauptbefehl
;; ============================================================
(defun c:TEST_GEFAELLESTRECKE ( /
results-list tests-out-dir
test-deltaL test-winkel test-z-start test-rad sep-x test-L_stau
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.)
(if (not *lib-initialized*)
(gf-init-bibliothek))
(if (not *lib-initialized*)
(progn
(alert "gf-init-bibliothek fehlgeschlagen! Abbruch.")
(exit)))
(ssg-start "TEST_GEFAELLESTRECKE"
'(("OSMODE") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; Test-Layer anlegen (gruen)
(setq lbl-layer "GF_Test")
(setq lbl-h 400.0) ; Einzeltest-Beschriftung
(setq lbl-h2 600.0) ; Abschnitts-Ueberschrift
(if (not (tblsearch "LAYER" lbl-layer))
(entmake
(list '(0 . "LAYER") (cons 2 lbl-layer) '(70 . 0) '(62 . 3))))
(setq results-list '())
;; --- Gemeinsame Testparameter ---
(setq test-deltaL 10000.0)
(setq test-winkel 3.0)
(setq test-z-start 5000.0)
(setq test-rad (* test-winkel (/ pi 180.0)))
;; L_stau = (deltaL - aus-dx - ein-dx - sep_x) / cos(v)
;; sep_x = horizontale Projektion des Separators (300 * cos(v))
(setq sep-x (* 300.0 (cos test-rad)))
(setq test-L_stau
(/ (- test-deltaL (float aus-dx) (float ein-dx) sep-x) (cos test-rad)))
(princ "\n")
(princ "\n================================================================")
(princ "\n TEST_GEFAELLESTRECKE - Integrationstest alle Modi")
(princ "\n================================================================")
(princ (strcat "\n deltaL=" (rtos test-deltaL 2 0) " mm"
" Winkel=" (rtos test-winkel 2 1) " Grad"
" Z_Start=" (rtos test-z-start 2 0) " mm"))
(princ (strcat "\n aus-dx=" (rtos (float aus-dx) 2 1) " mm"
" ein-dx=" (rtos (float ein-dx) 2 1) " mm"
" L_stau=" (rtos test-L_stau 2 1) " mm"))
(princ "\n================================================================")
;; ============================================================
;; MODUS 1 - 4 Richtungen
;; Layout:
;; hz= 0 (Ost) Start ( 0, 0, 5000), Kette nach +X
;; hz= 90 (Nord) Start (15000, 0, 5000), Kette nach +Y
;; hz=180 (West) Start ( 0, -15000, 5000), Kette nach -X
;; hz=270 (Sued) Start (15000,-15000, 5000), Kette nach -Y
;; ============================================================
(princ "\n\n================================================================")
(princ "\n MODUS 1 - 4 Richtungen")
(princ "\n================================================================")
;; Abschnitts-Ueberschrift in Zeichnung
(entmake (list '(0 . "TEXT")
(cons 10 (list -2000 2500.0 test-z-start))
(cons 11 (list -2000 2500.0 test-z-start))
(cons 40 lbl-h2)
(cons 1 (strcat "MODUS 1 - 4 Richtungen | " delta-sym "L=10000mm | W=3" grad-zeichen))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 0) '(73 . 2)))
;; --- M1: hz=0 Grad (Ost), Start (0, 0, 5000) ---
(princ "\n\n M1_hz000: hz=0, Start=(0,0,5000) ...")
(entmake (list '(0 . "TEXT")
(cons 10 (list 0 1200.0 test-z-start))
(cons 11 (list 0 1200.0 test-z-start))
(cons 40 lbl-h)
(cons 1 (strcat "M1 | hz=0" grad-zeichen " (Ost) | " delta-sym "L=10000 | W=3" grad-zeichen))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2)))
(setq gf-ins
(car (gefaellestrecke-einfuegen
test-L_stau test-winkel (list 0 0 test-z-start)
"links" "links" 0.0 test-deltaL)))
(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 " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz000" 1 0.0 test-deltaL
(atof w-str) h-von h-bis d-h "GEBAUT")
results-list)))
(progn
(princ " FEHLER")
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz000" 1 0.0 test-deltaL
0.0 0 0 0 "FEHLER")
results-list))))
;; --- M1: hz=90 Grad (Nord), Start (15000, 0, 5000) ---
(princ "\n\n M1_hz090: hz=90, Start=(15000,0,5000) ...")
(entmake (list '(0 . "TEXT")
(cons 10 (list 15000 1200.0 test-z-start))
(cons 11 (list 15000 1200.0 test-z-start))
(cons 40 lbl-h)
(cons 1 (strcat "M1 | hz=90" grad-zeichen " (Nord) | " delta-sym "L=10000 | W=3" grad-zeichen))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2)))
(setq gf-ins
(car (gefaellestrecke-einfuegen
test-L_stau test-winkel (list 15000 0 test-z-start)
"links" "links" 90.0 test-deltaL)))
(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 " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz090" 1 90.0 test-deltaL
(atof w-str) h-von h-bis d-h "GEBAUT")
results-list)))
(progn
(princ " FEHLER")
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz090" 1 90.0 test-deltaL
0.0 0 0 0 "FEHLER")
results-list))))
;; --- M1: hz=180 Grad (West), Start (0, -15000, 5000) ---
(princ "\n\n M1_hz180: hz=180, Start=(0,-15000,5000) ...")
(entmake (list '(0 . "TEXT")
(cons 10 (list 0 -13800.0 test-z-start))
(cons 11 (list 0 -13800.0 test-z-start))
(cons 40 lbl-h)
(cons 1 (strcat "M1 | hz=180" grad-zeichen " (West) | " delta-sym "L=10000 | W=3" grad-zeichen))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2)))
(setq gf-ins
(car (gefaellestrecke-einfuegen
test-L_stau test-winkel (list 0 -15000 test-z-start)
"links" "links" 180.0 test-deltaL)))
(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 " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz180" 1 180.0 test-deltaL
(atof w-str) h-von h-bis d-h "GEBAUT")
results-list)))
(progn
(princ " FEHLER")
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz180" 1 180.0 test-deltaL
0.0 0 0 0 "FEHLER")
results-list))))
;; --- M1: hz=270 Grad (Sued), Start (15000, -15000, 5000) ---
(princ "\n\n M1_hz270: hz=270, Start=(15000,-15000,5000) ...")
(entmake (list '(0 . "TEXT")
(cons 10 (list 15000 -13800.0 test-z-start))
(cons 11 (list 15000 -13800.0 test-z-start))
(cons 40 lbl-h)
(cons 1 (strcat "M1 | hz=270" grad-zeichen " (Sued) | " delta-sym "L=10000 | W=3" grad-zeichen))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2)))
(setq gf-ins
(car (gefaellestrecke-einfuegen
test-L_stau test-winkel (list 15000 -15000 test-z-start)
"links" "links" 270.0 test-deltaL)))
(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 " von=" (itoa h-von) " bis=" (itoa h-bis)
" dH=" (itoa d-h) " mm W=" w-str " OK"))
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz270" 1 270.0 test-deltaL
(atof w-str) h-von h-bis d-h "GEBAUT")
results-list)))
(progn
(princ " FEHLER")
(setq results-list
(cons (gefaellestrecke:test-json "M1_hz270" 1 270.0 test-deltaL
0.0 0 0 0 "FEHLER")
results-list))))
;; ============================================================
;; MODUS 2 - Linie entlang X-Achse
;; Linie von (0,-35000,0) nach (10000,-35000,0)
;; Startpunkt Gefaellestrecke: (0,-35000,5000), hz=0 Grad
;; ============================================================
(princ "\n\n================================================================")
(princ "\n MODUS 2 - Linie entlang X-Achse (hz=0)")
(princ "\n================================================================")
;; Abschnitts-Ueberschrift und Richtungslinie in Zeichnung
(entmake (list '(0 . "TEXT")
(cons 10 (list -2000 -32500.0 test-z-start))
(cons 11 (list -2000 -32500.0 test-z-start))
(cons 40 lbl-h2)
(cons 1 (strcat "MODUS 2 - Linie X-Achse | hz=0 | W=3" grad-zeichen))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 0) '(73 . 2)))
(entmake (list '(0 . "LINE")
'(10 0 -35000 0) '(11 10000 -35000 0) (cons 8 lbl-layer)))
(entmake (list '(0 . "TEXT")
(cons 10 (list 5000 -33800.0 test-z-start))
(cons 11 (list 5000 -33800.0 test-z-start))
(cons 40 lbl-h)
(cons 1 (strcat "M2 | hz=0" grad-zeichen " | Linie X-Achse | W=3" grad-zeichen))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2)))
(setq m2-start (list 0 -35000 test-z-start))
(princ (strcat "\n\n M2_hz000: Start=(0,-35000," (rtos test-z-start 2 0) ") ..."))
(setq ergebnis
(gefaellestrecke-einfuegen
test-L_stau test-winkel m2-start "links" "links" 0.0 test-deltaL))
(setq gf-ins (car ergebnis))
(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))))
;; 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 "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)
" mm W=" w-str " OK"))
(setq results-list
(cons (gefaellestrecke:test-json "M2_hz000" 2 0.0 test-deltaL
(atof w-str) h-von h-bis m2-deltaH "GEBAUT")
results-list)))
(progn
;; Fallback: sin(3deg) * 10000 ≈ 523mm
(setq m2-deltaH 523.0)
(setq m2-deltaL test-deltaL)
(princ (strcat " FEHLER (Fallback " delta-sym "H=" (rtos m2-deltaH 2 3) ")"))
(setq results-list
(cons (gefaellestrecke:test-json "M2_hz000" 2 0.0 test-deltaL
0.0 0 0 0 "FEHLER")
results-list))))
;; ============================================================
;; MODUS 3 - 3D-Linie entlang Y-Achse (Sued) mit Delta aus M2
;; Z-Startpunkt, Z-Endpunkt und die horizontale Distanz werden 1:1 aus
;; dem M2-Ergebnis uebernommen (volle Fliesskomma-Genauigkeit, kein
;; Runden auf ganze mm) - nur die Fahrtrichtung ist bewusst anders
;; (Sued statt Ost), um die Richtungsunabhaengigkeit zu pruefen.
;; 3D-Linie: (0,-50000,Z_start) -> (0, -50000-m2-deltaL, Z_start-m2-deltaH)
;; Startpunkt: (0,-50000,Z_start) = hoehere Seite
;; ============================================================
(princ "\n\n================================================================")
(princ (strcat "\n MODUS 3 - 3D-Linie Y-Achse Sued, " delta-sym "H="
(rtos m2-deltaH 2 3) " mm " delta-sym "L=" (rtos m2-deltaL 2 3)
" mm (aus M2)"))
(princ "\n================================================================")
(setq m3-start (list 0.0 -50000.0 test-z-start))
(setq m3-end (list 0.0 (- -50000.0 m2-deltaL) (- test-z-start m2-deltaH)))
;; Abschnitts-Ueberschrift und 3D-Linie in Zeichnung
(entmake (list '(0 . "TEXT")
(cons 10 (list -2000 -47500.0 test-z-start))
(cons 11 (list -2000 -47500.0 test-z-start))
(cons 40 lbl-h2)
(cons 1 (strcat "MODUS 3 - 3D-Linie Y-Achse Sued | " delta-sym "H="
(rtos m2-deltaH 2 3) "mm aus M2"))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 0) '(73 . 2)))
(entmake (list '(0 . "TEXT")
(cons 10 (list 0 -48800.0 test-z-start))
(cons 11 (list 0 -48800.0 test-z-start))
(cons 40 lbl-h)
(cons 1 (strcat "M3 | 3D-Linie Sued | " delta-sym "H=" (rtos m2-deltaH 2 3) "mm"))
'(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2)))
(princ (strcat "\n\n 3D-Linie: (" (rtos (car m3-start) 2 3) ","
(rtos (cadr m3-start) 2 3) ","
(rtos (caddr m3-start) 2 3) ")"
" -> (" (rtos (car m3-end) 2 3) ","
(rtos (cadr m3-end) 2 3) ","
(rtos (caddr m3-end) 2 3) ")"))
(if (entmake
(list '(0 . "LINE")
(cons 10 m3-start)
(cons 11 m3-end)
(cons 8 lbl-layer)))
(progn
;; VLA-Objekt aus letztem entlast holen
(setq m3-line-vla (vlax-ename->vla-object (entlast)))
(setq gf-ins
(gefaellestrecke:modus3-einfuegen
(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_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=" (rtos m2-deltaH 2 3) " mm"
" Abw=" (rtos (abs (- d-h m2-deltaH)) 2 3) " mm"
" W=" w-str " OK"))
(setq results-list
(cons (gefaellestrecke:test-json "M3_hz270" 3 270.0 test-deltaL
(atof w-str) h-von h-bis d-h "GEBAUT")
results-list)))
(progn
(princ "\n -> FEHLER (modus3-einfuegen)")
(setq results-list
(cons (gefaellestrecke:test-json "M3_hz270" 3 270.0 test-deltaL
0.0 0 0 0 "FEHLER")
results-list)))))
;; 3D-Linie konnte nicht erzeugt werden
(progn
(princ "\n FEHLER: 3D-Linie nicht erzeugbar!")
(setq results-list
(cons (gefaellestrecke:test-json "M3_hz270" 3 270.0 test-deltaL
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
;; ============================================================
(princ "\n\n================================================================")
(princ (strcat "\n " (itoa (length results-list)) " Tests durchgefuehrt"))
(princ "\n================================================================")
;; Ergebnisse in globaler Variable speichern (fuer SSG_RUN_ALL_TESTS)
(setq *gefaellestrecke-test-results* (reverse results-list))
;; Direkt exportieren
(setq tests-out-dir
(strcat (getenv "DXFMAKRO") "/tests/output"))
(vl-mkdir tests-out-dir)
(gefaellestrecke:export-results tests-out-dir)
(ssg-end)
(princ "\n================================================================")
(princ "\n TEST_GEFAELLESTRECKE abgeschlossen.")
(princ "\n================================================================")
(princ)
)
Reference in New Issue View Git Blame Copy Permalink