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

die 3 Modus für Gefällestrecke wurden angepasst.Gemeinsamkeit aller Modi: Innere Elemente (Separator, Gefällebogen) werden immer per vollständiger KS_EIN→KS_AUS-3D-Rahmen-Kettung verkettet (insert-block-ks-to-ks) — nur bei AS/ES-Element (wegen des seitlichen Drehteller-Versatzes) wird die Position in X/Y und Z getrennt behandelt.Unterschied Modus 1/2 vs. Modus 3: In Modus 1/2 gibt es keinen vorgegebenen Endpunkt — die Endhöhe ist ein Ergebnis. In Modus 3 sind Start und Endpunkt (mit Höhen) vorgegeben, und die gesamte Geometrie (Winkel, Bogenauswahl, Segmentlängen) wird so berechnet, dass beide Punkte exakt erreicht werden. Test-Gefällestrecke wurde gebaut

Browse Source
This commit is contained in:
Yuelin Wang
2026-07-01 16:06:16 +02:00
parent 649857a9dd
commit b915980540
5 changed files with 1140 additions and 128 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/Gefaellestrecke.lsp
+343 -118
View File
@@ -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.")
)
)
Lisp/vf_core.lsp
+149 -5
View File
@@ -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
)
)
menu/SSG_LIB.mnu
+2 -1
View File
@@ -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
tests/alltests.json
+5 -4
View File
@@ -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" }
]
tests/test_gefaellestrecke.lsp
+641
View File
@@ -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)
)