From b915980540777228b7bc3fd3f8eb523e01978140 Mon Sep 17 00:00:00 2001 From: Yuelin Wang Date: Wed, 1 Jul 2026 16:06:16 +0200 Subject: [PATCH] =?UTF-8?q?die=203=20Modus=20f=C3=BCr=20Gef=C3=A4llestreck?= =?UTF-8?q?e=20wurden=20angepasst.Gemeinsamkeit=20aller=20Modi:=20Innere?= =?UTF-8?q?=20Elemente=20(Separator,=20Gef=C3=A4llebogen)=20werden=20immer?= =?UTF-8?q?=20per=20vollst=C3=A4ndiger=20KS=5FEIN=E2=86=92KS=5FAUS-3D-Rahm?= =?UTF-8?q?en-Kettung=20verkettet=20(insert-block-ks-to-ks)=20=E2=80=94=20?= =?UTF-8?q?nur=20bei=20AS/ES-Element=20(wegen=20des=20seitlichen=20Drehtel?= =?UTF-8?q?ler-Versatzes)=20wird=20die=20Position=20in=20X/Y=20und=20Z=20g?= =?UTF-8?q?etrennt=20behandelt.Unterschied=20Modus=201/2=20vs.=20Modus=203?= =?UTF-8?q?:=20In=20Modus=201/2=20gibt=20es=20keinen=20vorgegebenen=20Endp?= =?UTF-8?q?unkt=20=E2=80=94=20die=20Endh=C3=B6he=20ist=20ein=20Ergebnis.?= =?UTF-8?q?=20In=20Modus=203=20sind=20Start=20und=20Endpunkt=20(mit=20H?= =?UTF-8?q?=C3=B6hen)=20vorgegeben,=20und=20die=20gesamte=20Geometrie=20(W?= =?UTF-8?q?inkel,=20Bogenauswahl,=20Segmentl=C3=A4ngen)=20wird=20so=20bere?= =?UTF-8?q?chnet,=20dass=20beide=20Punkte=20exakt=20erreicht=20werden.=20T?= =?UTF-8?q?est-Gef=C3=A4llestrecke=20wurde=20gebaut?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lisp/Gefaellestrecke.lsp | 461 ++++++++++++++++++------ Lisp/vf_core.lsp | 154 +++++++- menu/SSG_LIB.mnu | 3 +- tests/alltests.json | 9 +- tests/test_gefaellestrecke.lsp | 641 +++++++++++++++++++++++++++++++++ 5 files changed, 1140 insertions(+), 128 deletions(-) create mode 100644 tests/test_gefaellestrecke.lsp diff --git a/Lisp/Gefaellestrecke.lsp b/Lisp/Gefaellestrecke.lsp index 6e195e6..a94f84d 100644 --- a/Lisp/Gefaellestrecke.lsp +++ b/Lisp/Gefaellestrecke.lsp @@ -42,6 +42,10 @@ ;; Werden von vf_standard.lsp ueberschrieben, falls geladen. (if (null aus-dx) (setq aus-dx 526.0)) (if (null ein-dx) (setq ein-dx 576.0)) +;; Z-Versatz KS_EIN->KS_AUS in Neutrallage (positiv = nach unten) +;; Werden in gf-init-bibliothek gemessen. +(if (null aus-dz) (setq aus-dz 0.0)) +(if (null ein-dz) (setq ein-dz 0.0)) ;; Lokale KS_EIN-Positionen (Blockursprung-relative Koordinaten, fuer Modus 3) ;; Werden in init-bibliothek gesetzt. (if (null *aus-ks-ein-local*) (setq *aus-ks-ein-local* nil)) @@ -49,6 +53,9 @@ (if (null *lib-initialized*) (setq *lib-initialized* nil)) ;; Laufende GF-Blocknummer (sitzungspersistent) (if (null #GF_LetzteNr) (setq #GF_LetzteNr 0)) +;; Hilfs-Globals fuer Winkelkorrektur (gesetzt von gf-winkel-berechnen) +(if (null *gf-L-ohne-as-es*) (setq *gf-L-ohne-as-es* nil)) +(if (null *gf-sum-dz-bogen*) (setq *gf-sum-dz-bogen* 0.0)) ;; DXFM_DIM lesen; 2D wird auf 3D korrigiert (Gefaellestrecke benoetigt Z-Geometrie) (setq *gf-dxfm-dim* (getenv "DXFM_DIM")) @@ -306,11 +313,44 @@ ) ;; --- Rotierter Block mit manuellem dx/dz (Richtung X) --- +;; KS_EIN (nicht der Block-Ursprung) wird auf startpunkt ausgerichtet, siehe +;; Kommentar an der kanonischen Definition in vf_core.lsp. (if (null (car (atoms-family 1 '("INSERT-ROTATED-BLOCK-WITH-KS")))) + ;; block-dx/block-dz: Fallback, nur falls KS_AUS nicht extrahierbar. + ;; Ist KS_AUS vorhanden, wird der echte Versatz KS_AUS-KS_EIN verwendet + ;; (schuetzt vor veralteten Config-Zahlen), siehe vf_core.lsp. (defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz / - rad block-obj endpunkt) + rad block-obj temp-obj ks-data + ks-ein-raw ks-aus-raw + ein-x ein-y ein-z aus-x aus-y aus-z + dx dz ins-pt) (ensure-block-loaded blockname) (setq rad (* (float winkel) (/ pi 180.0))) + ;; Lokale KS_EIN/KS_AUS-Position ueber EIGENES Temp-Objekt ermitteln + ;; (nicht am spaeter tatsaechlich platzierten block-obj), siehe vf_core.lsp. + (setq temp-obj + (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (setq ks-data (extract-ks-from-block temp-obj)) + (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) + (setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data))) + (setq ein-x 0.0 ein-y 0.0 ein-z 0.0) + (if ks-ein-raw + (setq ein-x (car (car ks-ein-raw)) + ein-y (cadr (car ks-ein-raw)) + ein-z (caddr (car ks-ein-raw))) + ) + (setq dx block-dx dz block-dz) + (if ks-aus-raw + (progn + (setq aus-x (car (car ks-aus-raw)) + aus-y (cadr (car ks-aus-raw)) + aus-z (caddr (car ks-aus-raw))) + (setq dx (- aus-x ein-x) dz (- aus-z ein-z)) + ) + ) (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) @@ -320,15 +360,19 @@ (list 0 1 0 0) (list (- (sin rad)) 0 (cos rad) 0) (list 0 0 0 1)))) + (setq ins-pt (list + (- (car startpunkt) (+ (* ein-x (cos rad)) (* ein-z (sin rad)))) + (- (cadr startpunkt) ein-y) + (- (caddr startpunkt) (+ (* (- (sin rad)) ein-x) (* (cos rad) ein-z))))) (vla-Move block-obj (vlax-3D-point '(0 0 0)) - (vlax-3D-point startpunkt)) + (vlax-3D-point ins-pt)) (list (+ (car startpunkt) - (+ (* block-dx (cos rad)) (* block-dz (sin rad)))) + (+ (* dx (cos rad)) (* dz (sin rad)))) (cadr startpunkt) (+ (caddr startpunkt) - (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz)))) + (+ (* (- (sin rad)) dx) (* (cos rad) dz)))) ) ) @@ -396,6 +440,7 @@ (if (and ks-ein ks-aus) (progn (setq aus-dx (- (caar ks-aus) (caar ks-ein))) + (setq aus-dz (- (caddr (car ks-ein)) (caddr (car ks-aus)))) (setq *aus-ks-ein-local* (car ks-ein)) ) ) @@ -416,11 +461,16 @@ (if (and ks-ein ks-aus) (progn (setq ein-dx (- (caar ks-aus) (caar ks-ein))) + (setq ein-dz (- (caddr (car ks-ein)) (caddr (car ks-aus)))) (setq *ein-ks-ein-local* (car ks-ein)) ) ) ) ) + (princ (strcat "\n[GF-Lib] AS: dx=" (rtos (float aus-dx) 2 1) + " dz=" (rtos (float aus-dz) 2 1))) + (princ (strcat "\n[GF-Lib] ES: dx=" (rtos (float ein-dx) 2 1) + " dz=" (rtos (float ein-dz) 2 1))) (setq *lib-initialized* t) (setq *gf-lib-geladen* t) t @@ -749,17 +799,22 @@ ;; Gefaellewinkel (Grad) aus Segmentliste und deltaH berechnen. ;; deltaH: positiver Hoehenunterschied in mm (Gesamt-Abfall) ;; extra-sep: zusaetzliche Separatoren ausserhalb der Bogen (z.B. 1 vor EIN-Element) -;; Formel: deltaH = (L_gerade + (n_bogen+extra_sep)*300) * sin(alpha) + sum(|dz_bogen|) +;; Formel (Naeherung): sin(v) = (deltaH - aus-dz - ein-dz - sum(|dz_bogen|)) +;; / (L_gerade + aus-dx + ein-dx + sum(dx_bogen)) +;; Setzt Globals fuer Korrekturschritt: +;; *gf-L-ohne-as-es* - Laenge ohne AS/ES-dx (fuer gemessene Korrektur) +;; *gf-sum-dz-bogen* - Summe dz-Anteile der Bogen (defun gf-winkel-berechnen (segmente deltaH extra-sep / - L-gerade sum-dz-bogen n-bogen - seg bwinkel bseite masse sin-alpha alpha) - (setq L-gerade 0.0 sum-dz-bogen 0.0 n-bogen 0) + L-gerade sum-dz-bogen sum-dx-bogen n-bogen + seg bwinkel bseite masse sin-alpha alpha deltaH-eff) + (setq L-gerade 0.0 sum-dz-bogen 0.0 sum-dx-bogen 0.0 n-bogen 0) (foreach seg segmente (if (= (car seg) "Linie") (setq L-gerade (+ L-gerade (caddr seg))) (progn (setq bwinkel (nth 3 seg) bseite (nth 4 seg)) (setq masse (gf-bogen-masse bwinkel bseite)) + (setq sum-dx-bogen (+ sum-dx-bogen (car masse))) (setq sum-dz-bogen (+ sum-dz-bogen (abs (cadr masse)))) (setq n-bogen (1+ n-bogen)) ) @@ -767,29 +822,55 @@ ) ;; Separator (300mm): je einen vor jedem Bogen + extra-sep weitere (setq L-gerade (+ L-gerade (* (+ (float n-bogen) (float extra-sep)) 300.0))) - (princ (strcat "\n Gerade + Separatoren: " (rtos L-gerade 2 1) " mm")) - (princ (strcat "\n Bogen-dZ gesamt: " (rtos sum-dz-bogen 2 1) " mm")) - (princ (strcat "\n Resthoehe fuer Grade: " - (rtos (- (float deltaH) sum-dz-bogen) 2 1) " mm")) + ;; L ohne AS/ES-dx fuer Korrekturschritt exportieren + (setq *gf-L-ohne-as-es* (+ L-gerade (float sum-dx-bogen))) + (setq *gf-sum-dz-bogen* sum-dz-bogen) + ;; Gesamter Nenn-Laengenanteil: Gerade + AS/ES-dx + Bogen-dx + ;; dH_grade = L_total * sin(v); dH_fix = aus-dz + ein-dz + sum-dz-bogen + (setq L-gerade (+ L-gerade (float aus-dx) (float ein-dx) (float sum-dx-bogen))) + (setq deltaH-eff (- (float deltaH) (float aus-dz) (float ein-dz) sum-dz-bogen)) + (princ (strcat "\n Gesamte Nennlaenge (inkl. Bogen-dx): " (rtos L-gerade 2 1) " mm")) + (princ (strcat "\n Feste Hoehenanteile (AS/ES-dz + Bogen-dz): " + (rtos (+ (float aus-dz) (float ein-dz) sum-dz-bogen) 2 1) " mm")) + (princ (strcat "\n aus-dz=" (rtos (float aus-dz) 2 2) + " ein-dz=" (rtos (float ein-dz) 2 2) + " Bogen-dz=" (rtos sum-dz-bogen 2 2))) + (princ (strcat "\n Effektive Resthoehe fuer Grade: " (rtos deltaH-eff 2 1) " mm")) (cond ((<= L-gerade 0.1) (princ "\n WARNUNG: keine geraden Strecken -> Fallback 3 Grad") 3.0) - ((< (- (float deltaH) sum-dz-bogen) 0) - (princ "\n WARNUNG: Bogen-dZ > deltaH -> Fallback 1 Grad") + ((< deltaH-eff 0) + (princ "\n WARNUNG: feste Anteile > deltaH -> Fallback 1 Grad") 1.0) (t - (setq sin-alpha - (/ (- (float deltaH) sum-dz-bogen) L-gerade)) + (setq sin-alpha (/ deltaH-eff L-gerade)) (if (> sin-alpha 1.0) (setq sin-alpha 1.0)) (setq alpha (* (asin sin-alpha) (/ 180.0 pi))) - (princ (strcat "\n>>> Berechneter Gefaellewinkel: " - (rtos alpha 2 3) grad-zeichen)) + (princ (strcat "\n>>> Naeherungswinkel: " (rtos alpha 2 3) grad-zeichen)) alpha ) ) ) +;; Misst die tatsaechliche Z-Absenkung eines Blocks bei gegebener Eingangsrichtung. +;; Fuegt den Block temporaer an Ursprung ein, liest KS_AUS.Z, loescht den Block. +;; xu-dir: normierter 3D-Einheitsvektor der Eingangsrichtung (inkl. Neigung v) +;; Rueckgabe: Z-Absenkung in mm (positiv = nach unten) +(defun gf-messe-dz-block (blockname xu-dir / testframe frame-aus ent-vor ent-nach dz) + (setq testframe (make-frame-from-dir '(0 0 0) xu-dir)) + (setq ent-vor (entlast)) + (setq frame-aus (insert-block-ks-to-ks blockname testframe)) + (setq ent-nach (entlast)) + ;; Temporaer eingefuegten INSERT-Block loeschen + (if (and ent-nach (not (eq ent-nach ent-vor))) + (entdel ent-nach) + ) + ;; dz: KS_EIN war bei Z=0, KS_AUS.Z ist der Rueckgabewert + (setq dz (- 0.0 (caddr (car frame-aus)))) + dz +) + ;; Alle Segmente des Linienzugs einfuegen. ;; segmente : Ergebnis von gf-analysiere-kette ;; grade : Gefaellewinkel in Grad @@ -893,13 +974,16 @@ as-seite es-seite as-block es-block entry-hz exit-hz first-idx last-idx neu-l - chz shz as-target - aktuell-pt aktuell-frame nach-aus-pt + aktuell-frame nach-aus-pt gf-nummer last-ent L-gf-str delta-l-gf laengen-liste first-l l-item bL90 bL60 bL30 bR90 bR60 bR30 n-bogen-gf - rad-h-as rad-v-as xu-entry - sep-endpunkt rad-h-es rad-v-es xu-exit sep-frame) + 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 + 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-prev iter) (princ "\n\n>>> MODUS 3: Linienzug auswaehlen <<<") (princ "\nBitte alle Linien (LINE) und Boegen (ARC) des Pfades auswaehlen,") (princ "\ndann ENTER druecken:") @@ -920,16 +1004,18 @@ (setq i (1+ i)) ) - ;; Startpunkt: gleichzeitig Kettenanfang (Sortierung) UND Einfuegepunkt AUS-Element + ;; Startpunkt: Kettenanfang (Sortierung) + KS_EIN-Position des AUS-Elements + ;; Z-Hoehe = Anschlusshoehe der Gesamtstrecke (deltaH-Referenz oben) (setq startpunkt - (getpoint "\nStartpunkt (3D) waehlen - AUS-Element / Kettenanfang: ")) + (getpoint "\nStartpunkt (3D) waehlen - KS_EIN AUS-Element / Kettenanfang: ")) (if (null startpunkt) (progn (princ "\nKein Startpunkt!") (exit)) ) - ;; Endpunkt: Z-Koordinate fuer deltaH-Berechnung + ;; Endpunkt: KS_AUS-Position des EIN-Elements (Z-Referenz unten) + ;; deltaH = |startpunkt.Z - endpunkt-ref.Z| (setq endpunkt-ref - (getpoint "\nEndpunkt (3D) waehlen - EIN-Element / Kettenende: ")) + (getpoint "\nEndpunkt (3D) waehlen - KS_AUS EIN-Element / Kettenende: ")) (if (null endpunkt-ref) (progn (princ "\nKein Endpunkt!") (exit)) ) @@ -1049,10 +1135,58 @@ ) (setq grade (float grade)) + ;; Winkelkorrektur: iterative Messung der tatsaechlichen AS/ES-Absenkung. + ;; Jede Iteration misst dz_AS und dz_ES beim aktuellen Winkel und berechnet + ;; einen neuen Winkel. Konvergiert in 2-3 Schritten auf < 0.001 Grad. + ;; Garantiert: dz_AS(v) + L_stau*sin(v) + dz_ES(v) + dz_bogen = deltaH + (if (and *gf-L-ohne-as-es* (> *gf-L-ohne-as-es* 0.1)) + (progn + (princ "\n Messe tatsaechliche AS/ES-Absenkung (iterativ) ...") + (setq grade-prev -999.0 iter 0) + (while (and (< iter 4) (> (abs (- grade grade-prev)) 0.001)) + (setq grade-prev grade) + (setq rad-v-korr (* grade (/ pi 180.0))) + ;; AS-Element: KS_EIN zeigt 90 Grad zur Fahrtrichtung + (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)))) + ;; ES-Element: KS_EIN zeigt in Fahrtrichtung (exit-hz) + (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)) + ;; sin(v) = (dH - dz_as - dz_es - dz_bogen) / L_stau + (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)) + (setq grade (* (asin (/ dH-korr *gf-L-ohne-as-es*)) (/ 180.0 pi))) + (progn + (princ "\n WARNUNG: Korrektur ausserhalb Bereich, Winkel unveraendert") + (setq grade-prev grade) + ) + ) + (setq iter (1+ iter)) + ) + (princ (strcat "\n AS: " (rtos dz-as-ist 2 2) " mm" + " ES: " (rtos dz-es-ist 2 2) " mm")) + (princ (strcat "\n>>> Korrigierter Gefaellewinkel: " (rtos grade 2 3) grad-zeichen + " (nach " (itoa iter) " Iter.)")) + ) + ) + + ;; Horizontaldistanz Start->Ende fuer Zusammenfassung und Label + (setq delta-l-gf + (sqrt (+ (expt (- (car endpunkt-ref) (car startpunkt)) 2) + (expt (- (cadr endpunkt-ref) (cadr startpunkt)) 2)))) + ;; Zusammenfassung (princ "\n\n=========================================") (princ (strcat "\n>>> Segmente: " (itoa (length segmente)))) - (princ (strcat "\n>>> " delta-sym "H: " (rtos deltaH 2 1) " mm")) + (princ (strcat "\n>>> " delta-sym "H: " (rtos deltaH 2 2) " mm")) + (princ (strcat "\n>>> " delta-sym "L: " (rtos delta-l-gf 2 1) " mm")) (princ (strcat "\n>>> Gefaellewinkel: " (rtos grade 2 3) grad-zeichen)) (princ (strcat "\n>>> Eintrittswinkel: " (rtos entry-hz 2 1) grad-zeichen)) (princ (strcat "\n>>> Austrittswinkel: " (rtos exit-hz 2 1) grad-zeichen)) @@ -1068,36 +1202,32 @@ (setq gf-nummer (gf-next-number)) (setq last-ent (entlast)) - ;; AUS-Element: Block-Ursprung an startpunkt ausrichten. - ;; KS_EIN liegt im Block seitlich (Delta-Y = Drehteller-Anschluss). - ;; Damit KS_AUS auf der gezeichneten Linie liegt, muss der Einfuegepunkt - ;; um Rz(entry-hz) * ks_ein_local gegenueber startpunkt verschoben werden. - (setq chz (cos (* entry-hz (/ pi 180.0)))) - (setq shz (sin (* entry-hz (/ pi 180.0)))) - (if *aus-ks-ein-local* - (setq as-target - (list (+ (car startpunkt) - (- (* chz (car *aus-ks-ein-local*)) - (* shz (cadr *aus-ks-ein-local*)))) - (+ (cadr startpunkt) - (+ (* shz (car *aus-ks-ein-local*)) - (* chz (cadr *aus-ks-ein-local*)))) - (+ (caddr startpunkt) - (caddr *aus-ks-ein-local*)))) - (setq as-target startpunkt) - ) - (princ (strcat "\n\n>>> AUS-Element: " as-block - " (hz=" (rtos entry-hz 2 1) grad-zeichen ")")) - (setq aktuell-pt (gf-insert-gefaellebogen-by-ks as-block as-target entry-hz)) - (setq nach-aus-pt aktuell-pt) - - ;; Eingangsrahmen nach AS-Element: Position + geneigte Fahrtrichtung - (setq rad-h-as (* (float entry-hz) (/ pi 180.0))) - (setq rad-v-as (* (float grade) (/ pi 180.0))) + ;; AUS-Element: KS_EIN so ausrichten, dass KS_AUS in Fahrtrichtung entry-hz zeigt. + ;; Beweis: KS_AUS.xu = -yu(target-frame). Fuer KS_AUS||entry-hz gilt: + ;; rechts (Rechtskurve): KS_EIN = entry-hz + 90deg + ;; links (Linkskurve): KS_EIN = entry-hz - 90deg + (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)))) - (setq aktuell-frame (make-frame-from-dir aktuell-pt xu-entry)) + (princ (strcat "\n\n>>> AUS-Element: " as-block + " Fahrtrichtung=" (rtos entry-hz 2 1) grad-zeichen + " KS_EIN-hz=" (rtos ein-hz-as 2 1) grad-zeichen + " Z=" (rtos (caddr startpunkt) 2 1))) + ;; Block-Ursprung (nicht KS_EIN!) in X/Y auf startpunkt setzen, damit die + ;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den + ;; ausgewaehlten Startpunkt verlaeuft. KS_EIN sitzt seitlich versetzt + ;; (Drehteller-Anschluss) und darf daher nicht direkt auf startpunkt liegen. + ;; Die Z-Hoehe wird weiterhin an KS_EIN gemessen (konsistent mit Modus 1+2 + ;; und der Gefaellewinkel-Korrektur), damit KS_EIN.Z = startpunkt.Z gilt. + (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)) ;; Linienzug mit Gefaellebogen und Separatoren (Frame-basiert) (setq aktuell-frame (gf-linienzug-einfuegen segmente grade aktuell-frame)) @@ -1115,9 +1245,16 @@ (- (sin rad-v-es)))) (setq sep-frame (make-frame-from-dir sep-endpunkt xu-exit)) - ;; EIN-Element: KS_EIN an vollstaendigem Rahmen ausrichten (KS-zu-KS) - (princ (strcat "\n>>> EIN-Element: " es-block)) - (insert-block-ks-to-ks es-block sep-frame) + ;; EIN-Element: KS_EIN bleibt in X/Y auf dem Ketten-Pfad (sep-frame), + ;; seine eigene Achse verlaeuft damit trivial durch diesen Punkt. + ;; Die Z-Hoehe wird jedoch an KS_AUS gemessen, damit KS_AUS.Z exakt + ;; auf endpunkt-ref.Z landet (garantiert die gewuenschte DeltaH). + (princ (strcat "\n>>> EIN-Element: " 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")) ;; --- GF_N-Block erstellen --- @@ -1156,10 +1293,7 @@ ) (setq n-bogen-gf (+ bL90 bL60 bL30 bR90 bR60 bR30)) - ;; Horizontaldistanz Start->Ende (2D) - (setq delta-l-gf - (sqrt (+ (expt (- (car endpunkt-ref) (car startpunkt)) 2) - (expt (- (cadr endpunkt-ref) (cadr startpunkt)) 2)))) + ;; delta-l-gf bereits vor der Zusammenfassung berechnet ;; Block mit allen Attributen erstellen (gf-block-erstellen @@ -1212,7 +1346,9 @@ ) ) -;; Naechste freie GF-Nummer (scannt alle GF_* Bloecke nach Max-NUMMER) +;; Naechste freie GF-Nummer +;; Stufe 1: NUMMER-Attribut aller GF_*-Inserts lesen +;; Stufe 2: Block-Tabelle pruefen – GF_N darf noch nicht als Definition existieren (defun gf-next-number ( / ss i nr maxnr attribs) (setq maxnr 0) (setq ss (ssget "X" '((0 . "INSERT") (2 . "GF_*")))) @@ -1235,6 +1371,11 @@ ) (setq #GF_LetzteNr (max #GF_LetzteNr maxnr)) (setq #GF_LetzteNr (1+ #GF_LetzteNr)) + ;; Sicherstellen, dass GF_N noch nicht als Block-Definition existiert + (while (tblsearch "BLOCK" (strcat "GF_" (itoa #GF_LetzteNr))) + (princ (strcat "\n [GF-Nr] GF_" (itoa #GF_LetzteNr) " existiert bereits, naechste...")) + (setq #GF_LetzteNr (1+ #GF_LetzteNr)) + ) #GF_LetzteNr ) @@ -1245,7 +1386,7 @@ ;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht rechts versetzt. (defun gf-make-label (gf-nummer hoehe-von hoehe-bis deltaH deltaL L-gf-str winkel n-separator nach-aus-pt entry-hz L-first-seg / - label-txt label-pt chz-l shz-l halb) + label-txt label-pt chz-l shz-l halb basis-winkel) (setq chz-l (cos (* entry-hz (/ pi 180.0)))) (setq shz-l (sin (* entry-hz (/ pi 180.0)))) (setq halb (/ (float L-first-seg) 2.0)) @@ -1261,6 +1402,14 @@ " L=[" L-gf-str "]m" " W=" (rtos (float winkel) 2 2) grad-zeichen " Sep=" (itoa n-separator))) + ;; Basiswinkel: Text immer lesbar auf 0 Grad (X-Achse, links->rechts) oder + ;; 90 Grad (Y-Achse) einrasten - unabhaengig von der tatsaechlichen + ;; Fahrtrichtung (nie 180/270, damit der Text nie auf dem Kopf steht). + (setq basis-winkel (float entry-hz)) + (while (< basis-winkel 0.0) (setq basis-winkel (+ basis-winkel 360.0))) + (while (>= basis-winkel 360.0) (setq basis-winkel (- basis-winkel 360.0))) + (if (>= basis-winkel 180.0) (setq basis-winkel (- basis-winkel 180.0))) + (setq basis-winkel (if (or (< basis-winkel 45.0) (>= basis-winkel 135.0)) 0.0 90.0)) (entmake (list '(0 . "TEXT") (cons 10 label-pt) @@ -1269,6 +1418,7 @@ (cons 1 label-txt) '(7 . "Standard") '(8 . "GF_Beschriftung") + (cons 50 (* basis-winkel (/ pi 180.0))) '(72 . 1) '(73 . 2))) ) @@ -1343,68 +1493,108 @@ ;; ============================================================ ;; deltaL-total: gesamte Horizontaldistanz (fuer DELTA_L-Attribut) -(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt seite deltaL-total / - aktueller-punkt as-block es-block endpunkt - gf-nummer last-ent rad gf-deltaH L-gf-str - nach-aus-pt) - (setq aktueller-punkt startpunkt) - (setq as-block (strcat "AS_Element_90_" seite)) - (setq es-block (strcat "ES_Element_90_" seite)) +;; hz: Fahrtrichtung in Grad (0=Ost, 90=Nord, 180=West, 270=Sued) +(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt as-seite es-seite hz deltaL-total / + as-block es-block endpunkt + gf-nummer last-ent rad-hz rad-v xu-incl + ein-hz rad-ein xu-ein + startframe aktuell-frame + stau-endpunkt sep-endpunkt sep-frame + gf-deltaH L-gf-str nach-aus-pt gf-insert) + (setq as-block (strcat "AS_Element_90_" as-seite)) + (setq es-block (strcat "ES_Element_90_" es-seite)) (if (not *lib-initialized*) (gf-init-bibliothek)) ;; GF-Nummer und Entity-Grenze vor erster Einfuegung (setq gf-nummer (gf-next-number)) (setq last-ent (entlast)) - (princ (strcat "\n\n1/4: " as-block)) - (setq aktueller-punkt (insert-block-by-ks as-block aktueller-punkt)) - (setq nach-aus-pt aktueller-punkt) + ;; Fahrtrichtungsvektor (KS_AUS-Richtung, Basis fuer Staustrecke/Separator/ES) + (setq rad-hz (* (float hz) (/ pi 180.0))) + (setq rad-v (* (float winkel) (/ pi 180.0))) + (setq xu-incl (list (* (cos rad-hz)(cos rad-v)) + (* (sin rad-hz)(cos rad-v)) + (- (sin rad-v)))) + ;; KS_EIN-Richtung fuer AS-Element: so dass KS_AUS in Fahrtrichtung hz zeigt. + ;; Beweis: KS_AUS.xu = -yu (target-frame), yu = links-senkrecht zu xu. + ;; rechts (Rechtskurve): KS_AUS = KS_EIN - 90deg => KS_EIN = hz + 90deg + ;; links (Linkskurve): KS_AUS = KS_EIN + 90deg => KS_EIN = hz - 90deg + (setq ein-hz (if (= as-seite "rechts") (+ hz 90.0) (- hz 90.0))) + (setq rad-ein (* (float ein-hz) (/ pi 180.0))) + (setq xu-ein (list (* (cos rad-ein)(cos rad-v)) + (* (sin rad-ein)(cos rad-v)) + (- (sin rad-v)))) + + ;; 1/4: AUS-Element (KS_EIN an xu-ein ausrichten, damit KS_AUS in hz zeigt) + ;; Block-Ursprung (nicht KS_EIN!) in X/Y auf startpunkt setzen, damit die + ;; Mittelachse der Foerderstrecke (KS_AUS-Richtung) exakt durch den + ;; ausgewaehlten Startpunkt verlaeuft (analog Modus 3). Die Z-Hoehe wird + ;; weiterhin an KS_EIN gemessen, damit KS_EIN.Z = startpunkt.Z gilt. + (princ (strcat "\n\n1/4: " as-block + " Fahrtrichtung=" (rtos hz 2 1) grad-zeichen + " KS_EIN-hz=" (rtos ein-hz 2 1) grad-zeichen + " v=" (rtos winkel 2 1) grad-zeichen)) + (setq startframe (make-frame-from-dir startpunkt xu-ein)) + (setq aktuell-frame + (insert-block-mixed-to-ks as-block startframe (caddr startpunkt) nil "KS_EIN")) + (setq nach-aus-pt (car aktuell-frame)) + + ;; 2/4: Staustrecke (skalierbar, hz+vert) (princ (strcat "\n\n2/4: Staustrecke L=" (rtos L_stau 2 1) - " mm " (itoa winkel) grad-zeichen)) - (setq aktueller-punkt - (insert-inclined-scaled-block - "Staustrecke_SP_1000_mm" aktueller-punkt L_stau winkel)) + " mm hz=" (rtos hz 2 1) grad-zeichen + " v=" (rtos winkel 2 1) grad-zeichen)) + (setq stau-endpunkt + (gf-insert-hz-incl-scaled + "Staustrecke_SP_1000_mm" (car aktuell-frame) L_stau hz winkel)) + (setq aktuell-frame (make-frame-from-dir stau-endpunkt xu-incl)) - (princ (strcat "\n\n3/4: Separator 300mm " (itoa winkel) grad-zeichen)) - (setq aktueller-punkt - (insert-rotated-block-with-ks - "Staustrecke_Separator_SP_300_mm" aktueller-punkt winkel 300 0)) + ;; 3/4: Separator 300mm + (princ (strcat "\n\n3/4: Separator 300mm" + " hz=" (rtos hz 2 1) grad-zeichen + " v=" (rtos winkel 2 1) grad-zeichen)) + (setq sep-endpunkt + (gf-insert-hz-with-ks + "Staustrecke_Separator_SP_300_mm" (car aktuell-frame) hz winkel 300 0)) + (setq sep-frame (make-frame-from-dir sep-endpunkt xu-incl)) + ;; 4/4: EIN-Element (KS-zu-KS) (princ (strcat "\n\n4/4: " es-block)) - (setq endpunkt (insert-block-by-ks es-block aktueller-punkt)) + (setq endpunkt (car (insert-block-ks-to-ks es-block sep-frame))) - ;; Abgeleitete Werte fuer Attribute - (setq rad (* (float winkel) (/ pi 180.0))) - (setq gf-deltaH (* L_stau (sin rad))) + ;; Abgeleitete Werte: echte Endhoehe aus tatsaechlicher Ketten-Platzierung + ;; (AS_Element + Staustrecke + Separator + ES_Element zusammen) + (setq gf-deltaH (- (caddr startpunkt) (caddr endpunkt))) (setq L-gf-str (rtos (/ L_stau 1000.0) 2 3)) - ;; GF_N-Block mit Attributen erstellen - (gf-block-erstellen - "standard" seite gf-nummer - (caddr startpunkt) - (- (caddr startpunkt) gf-deltaH) - gf-deltaH - (float deltaL-total) - L-gf-str - winkel - 1 0 - 0 0 0 0 0 0 - startpunkt last-ent nach-aus-pt 0.0 (float L_stau)) + ;; GF_N-Block mit Attributen erstellen; Rueckgabe: ename des GF_N-INSERT + (setq gf-insert + (gf-block-erstellen + "standard" as-seite gf-nummer + (caddr startpunkt) + (caddr endpunkt) + gf-deltaH + (float deltaL-total) + L-gf-str + winkel + 1 0 + 0 0 0 0 0 0 + startpunkt last-ent nach-aus-pt (float hz) (float L_stau))) (princ "\n\n=========================================") (princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<") (princ "\n=========================================") - endpunkt + gf-insert ) ;; ============================================================ ;; TEIL 6: HAUPTBEFEHL ;; ============================================================ -(defun c:GEFAELLESTRECKE ( / antwort eingabe-modus deltaL winkel rad L_stau sep-x seite +(defun c:GEFAELLESTRECKE ( / antwort eingabe-modus deltaL winkel rad L_stau sep-x + as-seite es-seite line-points startpunkt endpunkt differenz - deltaX deltaY startpunkt-fuer-einfuegen) + deltaX deltaY startpunkt-fuer-einfuegen hz-winkel) (princ "\n=========================================") (princ "\n GEFAELLESTRECKE GENERATOR v2.0") @@ -1458,20 +1648,28 @@ (princ "\n BKS auf Weltkoordinaten gesetzt.") (setq line-points (get-line-start-end-points - "\nBitte 3D-Linie fuer die Gefaellestrecke auswaehlen:")) + "\nBitte 3D-Linie fuer Richtung und Laenge auswaehlen:")) (if (null line-points) (progn (alert "Keine gueltige Linie ausgewaehlt!") (exit)) ) (setq startpunkt (car line-points) endpunkt (cadr line-points)) (setq differenz (punkt-differenz startpunkt endpunkt)) - (setq deltaX (abs (car differenz)) - deltaY (abs (cadr differenz))) - (setq deltaL (max deltaX deltaY)) - (princ (strcat "\n deltaX=" (rtos deltaX 2 2) - " mm, deltaY=" (rtos deltaY 2 2) " mm")) + (setq deltaX (car differenz) + deltaY (cadr differenz)) + ;; deltaL: horizontale 2D-Projektion entlang Fahrtrichtung + (setq deltaL (sqrt (+ (* deltaX deltaX) (* deltaY deltaY)))) + ;; hz-Winkel: Fahrtrichtung aus Linienpunkten (in Grad, 0=Ost) + (setq hz-winkel (* (angle '(0.0 0.0) (list deltaX deltaY)) (/ 180.0 pi))) + (princ (strcat "\n Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen + " (aus Linie)")) (princ (strcat "\n " delta-sym "L = " (rtos deltaL 2 2) " mm")) - (setq startpunkt-fuer-einfuegen startpunkt) + ;; Startpunkt separat waehlen (unabhaengig von Linie) + (setq startpunkt-fuer-einfuegen + (getpoint "\nStartpunkt fuer AUS-Element waehlen: ")) + (if (null startpunkt-fuer-einfuegen) + (progn (princ "\nKein Startpunkt!") (exit)) + ) ) ) @@ -1479,7 +1677,7 @@ (princ (strcat "\n " delta-sym "L = " (rtos deltaL 2 2) " mm")) (princ "\n=========================================") - ;; Winkelabfrage + ;; Winkelabfrage (beide Modi: manuell) (setq winkel (getreal "\n\nGefaellewinkel (Grad) [3]: ")) (if (or (null winkel) (<= winkel 0)) (setq winkel (ssg-cfg-or "gefaelle" "default_winkel" 3.0))) @@ -1487,13 +1685,38 @@ (setq rad (* winkel (/ pi 180.0))) (princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen)) - ;; Seite waehlen - (princ "\n\nEin-/Auselement - Seite waehlen:") - (princ "\n 1 - Links (AS_Element_90_links / ES_Element_90_links)") - (princ "\n 2 - Rechts (AS_Element_90_rechts / ES_Element_90_rechts)") + ;; Fahrtrichtung waehlen (nur Modus 1; Modus 2 berechnet hz aus Linie) + (if (= eingabe-modus "Manuell") + (progn + (princ "\n\nFahrtrichtung waehlen:") + (princ "\n 1 - 0° (X-Achse +, Ost)") + (princ "\n 2 - 90° (Y-Achse +, Nord)") + (princ "\n 3 - 180° (X-Achse -, West)") + (princ "\n 4 - 270° (Y-Achse -, Sued)") + (setq antwort (getstring "\nIhre Wahl (1/2/3/4) [1]: ")) + (cond + ((= antwort "2") (setq hz-winkel 90.0)) + ((= antwort "3") (setq hz-winkel 180.0)) + ((= antwort "4") (setq hz-winkel 270.0)) + (t (setq hz-winkel 0.0)) + ) + (princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen)) + ) + ) + + ;; Seite AUS-Element waehlen + (princ "\n\nAUS-Element (AS_Element_90_*) - Seite waehlen:") + (princ "\n 1 - Links") + (princ "\n 2 - Rechts") (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) - (if (= antwort "2") (setq seite "rechts") (setq seite "links")) - (princ (strcat "\n>>> Seite: " seite)) + (setq as-seite (if (= antwort "2") "rechts" "links")) + + ;; Seite EIN-Element waehlen + (princ "\n\nEIN-Element (ES_Element_90_*) - Seite waehlen:") + (princ "\n 1 - Links") + (princ "\n 2 - Rechts") + (setq antwort (getstring "\nIhre Wahl (1/2) [1]: ")) + (setq es-seite (if (= antwort "2") "rechts" "links")) ;; Laengenberechnung ;; deltaL = aus_dx + L_stau*cos(rad) + sep*cos(rad) + ein_dx @@ -1512,15 +1735,17 @@ ;; Zusammenfassung (princ "\n\n=========================================") - (princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen)) - (princ (strcat "\n>>> Seite: " seite)) - (princ (strcat "\n>>> L_stau: " (rtos L_stau 2 2) " mm")) + (princ (strcat "\n>>> Fahrtrichtung: " (rtos hz-winkel 2 1) grad-zeichen)) + (princ (strcat "\n>>> Winkel: " (rtos winkel 2 1) grad-zeichen)) + (princ (strcat "\n>>> AUS-Seite: " as-seite)) + (princ (strcat "\n>>> EIN-Seite: " es-seite)) + (princ (strcat "\n>>> L_stau: " (rtos L_stau 2 2) " mm")) (princ "\n=========================================") ;; Bestaetigung (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: ")) (if (not (= antwort "2")) - (gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen seite deltaL) + (gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen as-seite es-seite hz-winkel deltaL) (princ "\nAbgebrochen.") ) ) diff --git a/Lisp/vf_core.lsp b/Lisp/vf_core.lsp index 9ed9c06..40ff0ae 100644 --- a/Lisp/vf_core.lsp +++ b/Lisp/vf_core.lsp @@ -541,6 +541,98 @@ " Z=" (rtos (caddr P-out) 2 2))) (list P-out xu-out yu-out zu-out)) +;; Fuegt Block ein: Orientierung wie insert-block-ks-to-ks (KS_EIN-Achsen werden +;; am Ziel-Rahmen ausgerichtet). Die POSITION wird jedoch fuer XY und Z aus +;; ZWEI VERSCHIEDENEN lokalen Referenzpunkten abgeleitet: +;; xy-ref : welcher lokale Punkt in X/Y exakt auf target-frame's P treffen soll +;; z-ref : welcher lokale Punkt in Z exakt auf z-ziel treffen soll +;; Werte fuer xy-ref/z-ref: "KS_EIN", "KS_AUS" oder nil (=Block-Ursprung 0,0,0). +;; Hintergrund: Bei seitlich angebundenen Elementen (z.B. AS_Element/ES_Element) +;; liegt KS_EIN bzw. KS_AUS seitlich versetzt vom Block-Ursprung (Drehteller- +;; Anschluss). Die Mittelachse der Foerderstrecke soll durch den Block-Ursprung +;; laufen (xy-ref), waehrend die Anschlusshoehe weiterhin exakt am jeweiligen +;; KS-Punkt (z-ref) gemessen werden muss (konsistent mit Modus 1+2 und der +;; Gefaellewinkel-Korrektur in gf-messe-dz-block). +;; target-frame : (P xt yt zt) - Ziel-Rahmen (Punkt auf der Mittelachse + Fahrtrichtung) +;; z-ziel : gewuenschte Welt-Z-Koordinate des z-ref-Punktes +;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks +(defun insert-block-mixed-to-ks (blockname target-frame z-ziel xy-ref z-ref / + block-obj ks-data ks-ein-raw ks-aus-raw + f-ein f-aus P-t xt yt zt + xe ye ze P-ein P-aus xu-aus yu-aus zu-aus + R P-xyref P-zref R-xyref R-zref tx ty tz T4 + R-Paus P-out xu-out yu-out zu-out) + (ensure-block-loaded blockname) + (if (not (tblsearch "BLOCK" blockname)) + (progn + (princ (strcat "\n FEHLER: Block '" blockname "' nicht in Bibliothek")) + (exit))) + ;; Ziel-Rahmen auspacken + (setq P-t (car target-frame) + xt (cadr target-frame) + yt (caddr target-frame) + zt (cadddr target-frame)) + ;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + ;; KS_EIN und KS_AUS extrahieren (nutzt Cache nach erstem Aufruf) + (setq ks-data (extract-ks-from-block block-obj)) + (setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data))) + (if (not (and ks-ein-raw ks-aus-raw)) + (progn + (princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'")) + (vla-Delete block-obj) + (exit))) + ;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen + (setq f-ein (ks-frame-extract ks-ein-raw) + f-aus (ks-frame-extract ks-aus-raw)) + (setq xe (cadr f-ein) ye (caddr f-ein) ze (cadddr f-ein)) + (setq P-ein (car f-ein)) + (setq P-aus (car f-aus) + xu-aus (cadr f-aus) + yu-aus (caddr f-aus) + zu-aus (cadddr f-aus)) + ;; Rotation identisch zu insert-block-ks-to-ks: R * xe = xt, R * ye = yt, R * ze = zt + (setq R (mat3-from-frames xt yt zt xe ye ze)) + ;; Lokale Referenzpunkte fuer XY- bzw. Z-Zielvorgabe bestimmen + (setq P-xyref + (cond ((= xy-ref "KS_EIN") P-ein) + ((= xy-ref "KS_AUS") P-aus) + (t '(0.0 0.0 0.0)))) + (setq P-zref + (cond ((= z-ref "KS_EIN") P-ein) + ((= z-ref "KS_AUS") P-aus) + (t '(0.0 0.0 0.0)))) + (setq R-xyref (mat3-mul-vec3 R P-xyref)) + (setq R-zref (mat3-mul-vec3 R P-zref)) + ;; Translation: xy-ref -> P-t (X/Y), z-ref -> z-ziel (Z) + (setq tx (- (car P-t) (car R-xyref))) + (setq ty (- (cadr P-t) (cadr R-xyref))) + (setq tz (- (float z-ziel) (caddr R-zref))) + ;; 4x4-Transformationsmatrix aufbauen und auf Block anwenden + (setq T4 (vlax-tmatrix + (list (list (car (car R)) (cadr (car R)) (caddr (car R)) tx) + (list (car (cadr R)) (cadr (cadr R)) (caddr (cadr R)) ty) + (list (car (caddr R)) (cadr (caddr R)) (caddr (caddr R)) tz) + (list 0.0 0.0 0.0 1.0)))) + (vla-TransformBy block-obj T4) + ;; Ausgabe-Rahmen fuer KS_AUS mathematisch berechnen (kein Re-Extrahieren noetig) + (setq R-Paus (mat3-mul-vec3 R P-aus)) + (setq P-out (list (+ (car R-Paus) tx) + (+ (cadr R-Paus) ty) + (+ (caddr R-Paus) tz))) + (setq xu-out (mat3-mul-vec3 R xu-aus) + yu-out (mat3-mul-vec3 R yu-aus) + zu-out (mat3-mul-vec3 R zu-aus)) + (princ (strcat "\n '" blockname "' eingefuegt (XY:" (if xy-ref xy-ref "Ursprung") + " Z:" (if z-ref z-ref "Ursprung") ")" + "\n KS_AUS: X=" (rtos (car P-out) 2 2) + " Y=" (rtos (cadr P-out) 2 2) + " Z=" (rtos (caddr P-out) 2 2))) + (list P-out xu-out yu-out zu-out)) + (defun insert-inclined-scaled-block (blockname startpunkt laenge winkel / rad matrix block-obj endpunkt scale) (if (<= laenge 0.1) @@ -582,8 +674,24 @@ ) ) +;; Fuegt Block ein und dreht ihn um die Y-Achse (Neigung, reine XZ-Ebene). +;; block-dx/block-dz: lokaler Versatz KS_AUS-KS_EIN (unrotiert), fuer den +;; zurueckgegebenen endpunkt. +;; WICHTIG: KS_EIN liegt nicht bei jedem Block exakt am Block-Ursprung +;; (z.B. bei Vario_Bogen). Damit KS_EIN und nicht der Block-Ursprung auf +;; startpunkt zu liegen kommt, wird der Ursprung um das rotierte lokale +;; KS_EIN-Versatz korrigiert. Fuer Bloecke mit KS_EIN=Ursprung (Separator, +;; Umlenk-/Motorstation) ist diese Korrektur 0 - Verhalten bleibt gleich. +;; block-dx/block-dz: Fallback-Laenge (aus Config), nur verwendet falls +;; KS_EIN/KS_AUS am Block nicht extrahiert werden koennen. Ist KS_AUS +;; vorhanden, wird der ECHTE gemessene Versatz KS_AUS-KS_EIN verwendet - +;; das schuetzt vor veralteten Config-Zahlen, die nicht mehr zur +;; tatsaechlichen Blockgeometrie passen (z.B. nach einer DWG-Bereinigung). (defun insert-rotated-block-with-ks (blockname startpunkt winkel block-dx block-dz / - rad matrix block-obj endpunkt) + rad matrix block-obj temp-obj ks-data + ks-ein-raw ks-aus-raw + ein-x ein-y ein-z aus-x aus-y aus-z + dx dz ins-pt endpunkt) (if (or (null startpunkt) (not (listp startpunkt))) (progn (princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'")) @@ -600,6 +708,35 @@ (princ (strcat "\n Fuege Block '" blockname "' ein" " (Rotation " (itoa winkel) (chr 176) ")")) (setq rad (* winkel (/ pi 180.0))) + ;; Lokale KS_EIN/KS_AUS-Position ueber EIGENES Temp-Objekt ermitteln + ;; (nicht am spaeter tatsaechlich platzierten block-obj - + ;; extract-ks-from-block exploded das uebergebene Objekt intern; das + ;; darf nicht das Objekt sein, das anschliessend gedreht/verschoben + ;; in der Zeichnung bleibt). + (setq temp-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) + (setq ks-data (extract-ks-from-block temp-obj)) + (if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj)) + (setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data))) + (setq ein-x 0.0 ein-y 0.0 ein-z 0.0) + (if ks-ein-raw + (setq ein-x (car (car ks-ein-raw)) + ein-y (cadr (car ks-ein-raw)) + ein-z (caddr (car ks-ein-raw))) + ) + ;; Echten Versatz KS_AUS-KS_EIN verwenden, sofern messbar (statt der + ;; ggf. veralteten Config-Werte block-dx/block-dz). + (setq dx block-dx dz block-dz) + (if ks-aus-raw + (progn + (setq aus-x (car (car ks-aus-raw)) + aus-y (cadr (car ks-aus-raw)) + aus-z (caddr (car ks-aus-raw))) + (setq dx (- aus-x ein-x) dz (- aus-z ein-z)) + ) + ) (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0)) @@ -610,15 +747,22 @@ (list 0 0 0 1) )) (vla-TransformBy block-obj (vlax-tmatrix matrix)) + ;; Block-Ursprung so verschieben, dass das ROTIERTE KS_EIN exakt auf + ;; startpunkt liegt: Ursprung = startpunkt - Rot(ks_ein_lokal) + (setq ins-pt (list + (- (car startpunkt) (+ (* ein-x (cos rad)) (* ein-z (sin rad)))) + (- (cadr startpunkt) ein-y) + (- (caddr startpunkt) (+ (* (- (sin rad)) ein-x) (* (cos rad) ein-z))))) (vla-Move block-obj (vlax-3D-point '(0 0 0)) - (vlax-3D-point startpunkt)) + (vlax-3D-point ins-pt)) (setq endpunkt (list - (+ (car startpunkt) (+ (* block-dx (cos rad)) (* block-dz (sin rad)))) + (+ (car startpunkt) (+ (* dx (cos rad)) (* dz (sin rad)))) (cadr startpunkt) - (+ (caddr startpunkt) (+ (* (- (sin rad)) block-dx) (* (cos rad) block-dz))))) + (+ (caddr startpunkt) (+ (* (- (sin rad)) dx) (* (cos rad) dz))))) (princ (strcat "\n Endpunkt: X=" (rtos (car endpunkt) 2 2) - " Z=" (rtos (caddr endpunkt) 2 2))) + " Z=" (rtos (caddr endpunkt) 2 2) + " (dx=" (rtos dx 2 1) " dz=" (rtos dz 2 1) ")")) endpunkt ) ) diff --git a/menu/SSG_LIB.mnu b/menu/SSG_LIB.mnu index 582ce67..99f4ba2 100644 --- a/menu/SSG_LIB.mnu +++ b/menu/SSG_LIB.mnu @@ -124,7 +124,8 @@ [Kreisel]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_kreisel.lsp")) TEST_KREISEL [Foerderer]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_foerderer.lsp")) TEST_FOERDERER [KS EIN/AUS]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_ks.lsp")) TEST_KSEINAUS -[<-Omniflo]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_omniflo.lsp")) TEST_OMNIFLO +[Omniflo]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_omniflo.lsp")) TEST_OMNIFLO +[<-Gefaellestrecke]^C^C(load (strcat (getenv "DXFMAKRO") "/tests/test_gefaellestrecke.lsp")) TEST_GEFAELLESTRECKE ***DOUBLECLICK [INSERT]^C^C(ssg-ensure "SSG_LIB_Commands") SSG_BLOCKEDIT diff --git a/tests/alltests.json b/tests/alltests.json index 8e7355e..64c3435 100644 --- a/tests/alltests.json +++ b/tests/alltests.json @@ -1,6 +1,7 @@ [ - { "name": "kreisel", "save": "dxf", "module": "KreiselInsert" }, - { "name": "foerderer", "save": "dwg", "module": "VarioFoerderer" }, - { "name": "kseinaus", "save": null, "module": "VarioFoerderer" }, - { "name": "omniflo", "save": "dxf", "module": "OmniModulInsert" } + { "name": "kreisel", "save": "dxf", "module": "KreiselInsert" }, + { "name": "foerderer", "save": "dwg", "module": "VarioFoerderer" }, + { "name": "kseinaus", "save": null, "module": "VarioFoerderer" }, + { "name": "omniflo", "save": "dxf", "module": "OmniModulInsert" }, + { "name": "gefaellestrecke", "save": "dxf", "module": "Gefaellestrecke" } ] diff --git a/tests/test_gefaellestrecke.lsp b/tests/test_gefaellestrecke.lsp new file mode 100644 index 0000000..856e2c1 --- /dev/null +++ b/tests/test_gefaellestrecke.lsp @@ -0,0 +1,641 @@ +;; ============================================================ +;; 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 (linie-vla 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 + (setq kette (gf-sortiere-objekte (list linie-vla) 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 (entlast)) + + ;; 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)))) + 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 attribs h-von h-bis d-h w-str + m2-start m2-deltaH + m3-start m3-end m3-line-vla + 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) + '(1 . "MODUS 1 - 4 Richtungen | dL=10000mm | W=3 Grad") + '(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) + '(1 . "M1 | hz=0 Grad (Ost) | dL=10000 | W=3 Grad") + '(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2))) + (setq gf-ins + (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" attribs)))) + (setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs)))) + (setq d-h (abs (- h-von h-bis))) + (setq w-str (cdr (assoc "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) + '(1 . "M1 | hz=90 Grad (Nord) | dL=10000 | W=3 Grad") + '(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2))) + (setq gf-ins + (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" attribs)))) + (setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs)))) + (setq d-h (abs (- h-von h-bis))) + (setq w-str (cdr (assoc "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) + '(1 . "M1 | hz=180 Grad (West) | dL=10000 | W=3 Grad") + '(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2))) + (setq gf-ins + (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" attribs)))) + (setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs)))) + (setq d-h (abs (- h-von h-bis))) + (setq w-str (cdr (assoc "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) + '(1 . "M1 | hz=270 Grad (Sued) | dL=10000 | W=3 Grad") + '(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2))) + (setq gf-ins + (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" attribs)))) + (setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs)))) + (setq d-h (abs (- h-von h-bis))) + (setq w-str (cdr (assoc "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) + '(1 . "MODUS 2 - Linie X-Achse | hz=0 | W=3 Grad") + '(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) + '(1 . "M2 | hz=0 Grad | Linie X-Achse | W=3 Grad") + '(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 gf-ins + (gefaellestrecke-einfuegen + test-L_stau test-winkel m2-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" attribs)))) + (setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs)))) + (setq m2-deltaH (abs (- h-von h-bis))) + (setq w-str (cdr (assoc "WINKEL" attribs))) + (princ (strcat " von=" (itoa h-von) " bis=" (itoa h-bis) + " dH=" (itoa m2-deltaH) " 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) + (princ (strcat " FEHLER (Fallback dH=" (itoa m2-deltaH) ")")) + (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 DeltaH aus M2 + ;; 3D-Linie: (0,-50000,5000) -> (0,-60000, 5000-m2-deltaH) + ;; Startpunkt: (0,-50000,5000) = hoehere Seite + ;; ============================================================ + (princ "\n\n================================================================") + (princ (strcat "\n MODUS 3 - 3D-Linie Y-Achse Sued, dH=" (itoa m2-deltaH) " mm (aus M2)")) + (princ "\n================================================================") + + (setq m3-start (list 0 -50000 test-z-start)) + (setq m3-end (list 0 -60000 (- test-z-start (float 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 | dH=" (itoa m2-deltaH) "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 | dH=" (itoa m2-deltaH) "mm")) + '(7 . "Standard") (cons 8 lbl-layer) '(72 . 1) '(73 . 2))) + + (princ (strcat "\n\n 3D-Linie: (" (rtos (car m3-start) 2 0) "," + (rtos (cadr m3-start) 2 0) "," + (rtos (caddr m3-start) 2 0) ")" + " -> (" (rtos (car m3-end) 2 0) "," + (rtos (cadr m3-end) 2 0) "," + (rtos (caddr m3-end) 2 0) ")")) + + (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 + 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 d-h (abs (- h-von h-bis))) + (setq w-str (cdr (assoc "WINKEL" attribs))) + (princ (strcat "\n -> von=" (itoa h-von) " bis=" (itoa h-bis) + " dH=" (itoa d-h) " mm" + " dH-Soll=" (itoa m2-deltaH) " mm" + " Abw=" (itoa (abs (- d-h m2-deltaH))) " 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)))) + + ;; ============================================================ + ;; 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) +)