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
)
)