diff --git a/Lisp/Gefaellestrecke.lsp b/Lisp/Gefaellestrecke.lsp index a94f84d..4659e57 100644 --- a/Lisp/Gefaellestrecke.lsp +++ b/Lisp/Gefaellestrecke.lsp @@ -239,7 +239,7 @@ ;; --- Block per KS_EIN/KS_AUS einfuegen --- (if (null (car (atoms-family 1 '("INSERT-BLOCK-BY-KS")))) (defun insert-block-by-ks (blockname einfuegepunkt / - block-obj ks-data ks-ein ks-aus offset ausgang) + block-obj temp-obj ks-data ks-ein ks-aus offset ausgang) (ensure-block-loaded blockname) (if (not (tblsearch "BLOCK" blockname)) (progn @@ -247,26 +247,33 @@ (exit) ) ) + ;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung 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 (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point einfuegepunkt) blockname 1.0 1.0 1.0 0)) - (setq ks-data (extract-ks-from-block block-obj)) - (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) - (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) (if (and ks-ein ks-aus) (progn (setq offset - (list (- (car einfuegepunkt) (car (car ks-ein))) - (- (cadr einfuegepunkt) (cadr (car ks-ein))) - (- (caddr einfuegepunkt) (caddr (car ks-ein))))) + (list (- (car (car ks-ein))) + (- (cadr (car ks-ein))) + (- (caddr (car ks-ein))))) (vla-Move block-obj - (vlax-3D-point (car ks-ein)) - (vlax-3D-point einfuegepunkt)) + (vlax-3D-point '(0 0 0)) + (vlax-3D-point offset)) (setq ausgang - (list (+ (car (car ks-aus)) (car offset)) - (+ (cadr (car ks-aus)) (cadr offset)) - (+ (caddr (car ks-aus)) (caddr offset)))) + (list (+ (car einfuegepunkt) (car (car ks-aus)) (car offset)) + (+ (cadr einfuegepunkt) (cadr (car ks-aus)) (cadr offset)) + (+ (caddr einfuegepunkt) (caddr (car ks-aus)) (caddr offset)))) (princ (strcat "\n KS_AUS Z=" (rtos (caddr ausgang) 2 2))) ausgang ) @@ -1198,9 +1205,12 @@ (setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: ")) (if (not (= antwort "2")) (progn - ;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern + ;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern. + ;; vf-lastent-ohne-attribute ueberspringt Attribut-Entities/SEQEND + ;; eines vorherigen GF_N/VF_N-Blocks, sonst rutschen sie in die + ;; naechste Blockerstellung hinein. (setq gf-nummer (gf-next-number)) - (setq last-ent (entlast)) + (setq last-ent (vf-lastent-ohne-attribute)) ;; 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: @@ -1507,7 +1517,7 @@ ;; GF-Nummer und Entity-Grenze vor erster Einfuegung (setq gf-nummer (gf-next-number)) - (setq last-ent (entlast)) + (setq last-ent (vf-lastent-ohne-attribute)) ;; Fahrtrichtungsvektor (KS_AUS-Richtung, Basis fuer Staustrecke/Separator/ES) (setq rad-hz (* (float hz) (/ pi 180.0))) @@ -1584,7 +1594,10 @@ (princ "\n\n=========================================") (princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<") (princ "\n=========================================") - gf-insert + ;; Rueckgabe: (ename echtes-deltaH echtes-deltaL) - volle Fliesskomma- + ;; Genauigkeit, unabhaengig von der auf ganze mm gerundeten HOEHE_VON/ + ;; HOEHE_BIS-Attribut-Darstellung im GF_N-Block. + (list gf-insert gf-deltaH (float deltaL-total)) ) ;; ============================================================ diff --git a/Lisp/vf_core.lsp b/Lisp/vf_core.lsp index 40ff0ae..7581eba 100644 --- a/Lisp/vf_core.lsp +++ b/Lisp/vf_core.lsp @@ -427,7 +427,7 @@ ;; ============================================================ ;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen) ;; ============================================================ -(defun insert-block-by-ks (blockname einfuegepunkt / block-obj ks-data ks-ein ks-aus offset ausgang) +(defun insert-block-by-ks (blockname einfuegepunkt / block-obj temp-obj ks-data ks-ein ks-aus offset ausgang) (if (or (null einfuegepunkt) (not (listp einfuegepunkt))) (progn (princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'")) @@ -442,23 +442,32 @@ ) ) (princ (strcat "\n Fuege Block '" blockname "' ein...")) + ;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht am + ;; spaeter tatsaechlich platzierten block-obj - extract-ks-from-block + ;; exploded das uebergebene Objekt intern), siehe insert-block-ks-to-ks. + (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 (cadr (assoc "KS_EIN" ks-data))) + (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) (setq block-obj (vla-InsertBlock modelspace (vlax-3D-point einfuegepunkt) blockname 1.0 1.0 1.0 0)) - (setq ks-data (extract-ks-from-block block-obj)) - (setq ks-ein (cadr (assoc "KS_EIN" ks-data))) - (setq ks-aus (cadr (assoc "KS_AUS" ks-data))) (if (and ks-ein ks-aus) (progn - (setq offset (list (- (car einfuegepunkt) (car (car ks-ein))) - (- (cadr einfuegepunkt) (cadr (car ks-ein))) - (- (caddr einfuegepunkt) (caddr (car ks-ein))))) + ;; offset verschiebt block-obj so, dass KS_EIN (aktuell bei + ;; einfuegepunkt+lokalerVersatz) exakt auf einfuegepunkt zu liegen kommt. + (setq offset (list (- (car (car ks-ein))) + (- (cadr (car ks-ein))) + (- (caddr (car ks-ein))))) (vla-Move block-obj - (vlax-3D-point (car ks-ein)) - (vlax-3D-point einfuegepunkt)) - (setq ausgang (list (+ (car (car ks-aus)) (car offset)) - (+ (cadr (car ks-aus)) (cadr offset)) - (+ (caddr (car ks-aus)) (caddr offset)))) + (vlax-3D-point '(0 0 0)) + (vlax-3D-point offset)) + (setq ausgang (list (+ (car einfuegepunkt) (car (car ks-aus)) (car offset)) + (+ (cadr einfuegepunkt) (cadr (car ks-aus)) (cadr offset)) + (+ (caddr einfuegepunkt) (caddr (car ks-aus)) (caddr offset)))) (princ (strcat "\n KS_AUS: X=" (rtos (car ausgang) 2 2) " Z=" (rtos (caddr ausgang) 2 2))) ausgang @@ -474,7 +483,7 @@ ;; target-frame : (P xt yt zt) - Ziel-Rahmen, z.B. KS_AUS des Vorgaenger-Elements ;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks (defun insert-block-ks-to-ks (blockname target-frame / - block-obj ks-data ks-ein-raw ks-aus-raw + block-obj temp-obj ks-data ks-ein-raw ks-aus-raw f-ein f-aus P-t xt yt zt P-ein xe ye ze P-aus xu-aus yu-aus zu-aus R R-Pein R-Paus tx ty tz T4 @@ -489,19 +498,26 @@ 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)) + ;; KS_EIN/KS_AUS 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 transformiert 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))) (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))) + ;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt + ;; bleibt tatsaechlich in der Zeichnung. + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) ;; 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)) @@ -557,7 +573,7 @@ ;; 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 + block-obj temp-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 @@ -572,19 +588,26 @@ 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)) + ;; KS_EIN/KS_AUS 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 transformiert 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))) (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))) + ;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt + ;; bleibt tatsaechlich in der Zeichnung. + (setq block-obj (vla-InsertBlock modelspace + (vlax-3D-point '(0 0 0)) + blockname 1.0 1.0 1.0 0)) ;; 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)) @@ -858,6 +881,26 @@ )) ) +;; Ermittelt den "letzten Entity" VOR einer neuen Einfuegung, so dass +;; nachfolgende Attribut-Entities/SEQEND eines vorherigen INSERT (z.B. eines +;; vorangegangenen VF_N-Blocks) nicht versehentlich in die naechste +;; vf-block-erstellen-Sammlung hineinfallen. Muss von JEDEM Aufrufer von +;; vf-block-erstellen anstelle eines nackten (entlast) verwendet werden. +(defun vf-lastent-ohne-attribute ( / ent) + (setq ent (entlast)) + (if (and ent + (= (cdr (assoc 0 (entget ent))) "INSERT") + (= (cdr (assoc 66 (entget ent))) 1)) + (progn + (setq ent (entnext ent)) + (while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND")) + (setq ent (entnext ent)) + ) + ) + ) + ent +) + ;; Erstellt VF_N-Block aus allen seit lastEnt erzeugten Entities. ;; Setzt Attributwerte entsprechend Typ, Seite und Geometrieparametern. (defun vf-block-erstellen (anlage-typ seite vf-nummer n-scanner @@ -1139,18 +1182,7 @@ (t hoehe-von))) ;; lastEnt VOR der Einfuegung merken - (setq lastEnt (entlast)) - (if (and lastEnt - (= (cdr (assoc 0 (entget lastEnt))) "INSERT") - (= (cdr (assoc 66 (entget lastEnt))) 1)) - (progn - (setq lastEnt (entnext lastEnt)) - (while (and lastEnt - (/= (cdr (assoc 0 (entget lastEnt))) "SEQEND")) - (setq lastEnt (entnext lastEnt)) - ) - ) - ) + (setq lastEnt (vf-lastent-ohne-attribute)) ;; Typ-spezifische Einfuegung (apply einfuege-fn diff --git a/tests/test_foerderer.lsp b/tests/test_foerderer.lsp index 1aa4483..1049bdd 100644 --- a/tests/test_foerderer.lsp +++ b/tests/test_foerderer.lsp @@ -163,7 +163,10 @@ (setq vf-nummer idx) (setq hoehe-von 0) (setq hoehe-bis (if (= richtung "Auf") deltaH (- deltaH))) - (setq lastEnt (entlast)) + ;; Wie c:VarioFoerderer: Attribut-Entities/SEQEND des vorherigen + ;; VF_N-Blocks ueberspringen, sonst rutschen sie in den naechsten + ;; Block hinein (Blockerstellung faengt sonst am falschen Entity an). + (setq lastEnt (vf-lastent-ohne-attribute)) (variofoerderer-einfuegen deltaL deltaH richtung best-winkel (/ L_GF 2.0) (/ L_GF 2.0) L_VF startpunkt "links") diff --git a/tests/test_gefaellestrecke.lsp b/tests/test_gefaellestrecke.lsp index 856e2c1..9c5928e 100644 --- a/tests/test_gefaellestrecke.lsp +++ b/tests/test_gefaellestrecke.lsp @@ -187,7 +187,7 @@ ;; 7. GF-Nummer und Entity-Grenze vor erster Einfuegung (setq gf-nummer (gf-next-number)) - (setq last-ent (entlast)) + (setq last-ent (vf-lastent-ohne-attribute)) ;; 8. AUS-Element einfuegen ;; KS_EIN-Richtung so, dass KS_AUS in entry-hz zeigt: @@ -291,8 +291,8 @@ (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 + 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 lbl-layer lbl-h lbl-h2) @@ -360,7 +360,7 @@ (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") + (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) --- @@ -369,12 +369,12 @@ (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") + (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 - (gefaellestrecke-einfuegen + (car (gefaellestrecke-einfuegen test-L_stau test-winkel (list 0 0 test-z-start) - "links" "links" 0.0 test-deltaL)) + "links" "links" 0.0 test-deltaL))) (if gf-ins (progn (setq attribs (ssg-attrib-read gf-ins)) @@ -401,12 +401,12 @@ (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") + (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 - (gefaellestrecke-einfuegen + (car (gefaellestrecke-einfuegen test-L_stau test-winkel (list 15000 0 test-z-start) - "links" "links" 90.0 test-deltaL)) + "links" "links" 90.0 test-deltaL))) (if gf-ins (progn (setq attribs (ssg-attrib-read gf-ins)) @@ -433,12 +433,12 @@ (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") + (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 - (gefaellestrecke-einfuegen + (car (gefaellestrecke-einfuegen test-L_stau test-winkel (list 0 -15000 test-z-start) - "links" "links" 180.0 test-deltaL)) + "links" "links" 180.0 test-deltaL))) (if gf-ins (progn (setq attribs (ssg-attrib-read gf-ins)) @@ -465,12 +465,12 @@ (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") + (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 - (gefaellestrecke-einfuegen + (car (gefaellestrecke-einfuegen test-L_stau test-winkel (list 15000 -15000 test-z-start) - "links" "links" 270.0 test-deltaL)) + "links" "links" 270.0 test-deltaL))) (if gf-ins (progn (setq attribs (ssg-attrib-read gf-ins)) @@ -505,7 +505,7 @@ (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") + (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))) @@ -513,68 +513,83 @@ (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") + (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 gf-ins + (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" attribs)))) (setq h-bis (atoi (cdr (assoc "HOEHE_BIS" attribs)))) - (setq m2-deltaH (abs (- h-von h-bis))) + ;; 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))) (princ (strcat " von=" (itoa h-von) " bis=" (itoa h-bis) - " dH=" (itoa m2-deltaH) " mm W=" w-str " OK")) + " " 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) - (princ (strcat " FEHLER (Fallback dH=" (itoa m2-deltaH) ")")) + (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 DeltaH aus M2 - ;; 3D-Linie: (0,-50000,5000) -> (0,-60000, 5000-m2-deltaH) - ;; Startpunkt: (0,-50000,5000) = hoehere Seite + ;; 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, dH=" (itoa m2-deltaH) " mm (aus M2)")) + (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 -50000 test-z-start)) - (setq m3-end (list 0 -60000 (- test-z-start (float m2-deltaH)))) + (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 | dH=" (itoa m2-deltaH) "mm aus M2")) + (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 | dH=" (itoa m2-deltaH) "mm")) + (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 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) ")")) + (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") @@ -595,9 +610,9 @@ (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" + " " 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