Attribut-Entities-Bug bei GF-Blockerstellung und VF-Blockerstellung in TEST-Funktionen beheben.

This commit is contained in:
2026-07-02 10:12:30 +02:00
parent b915980540
commit 11555ace8e
4 changed files with 160 additions and 97 deletions
+29 -16
View File
@@ -239,7 +239,7 @@
;; --- Block per KS_EIN/KS_AUS einfuegen ---
(if (null (car (atoms-family 1 '("INSERT-BLOCK-BY-KS"))))
(defun insert-block-by-ks (blockname einfuegepunkt /
block-obj ks-data ks-ein ks-aus offset ausgang)
block-obj temp-obj ks-data ks-ein ks-aus offset ausgang)
(ensure-block-loaded blockname)
(if (not (tblsearch "BLOCK" blockname))
(progn
@@ -247,26 +247,33 @@
(exit)
)
)
;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht
;; am spaeter tatsaechlich platzierten block-obj), siehe vf_core.lsp.
(setq temp-obj
(vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(setq block-obj
(vla-InsertBlock modelspace
(vlax-3D-point einfuegepunkt)
blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block block-obj))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(if (and ks-ein ks-aus)
(progn
(setq offset
(list (- (car einfuegepunkt) (car (car ks-ein)))
(- (cadr einfuegepunkt) (cadr (car ks-ein)))
(- (caddr einfuegepunkt) (caddr (car ks-ein)))))
(list (- (car (car ks-ein)))
(- (cadr (car ks-ein)))
(- (caddr (car ks-ein)))))
(vla-Move block-obj
(vlax-3D-point (car ks-ein))
(vlax-3D-point einfuegepunkt))
(vlax-3D-point '(0 0 0))
(vlax-3D-point offset))
(setq ausgang
(list (+ (car (car ks-aus)) (car offset))
(+ (cadr (car ks-aus)) (cadr offset))
(+ (caddr (car ks-aus)) (caddr offset))))
(list (+ (car einfuegepunkt) (car (car ks-aus)) (car offset))
(+ (cadr einfuegepunkt) (cadr (car ks-aus)) (cadr offset))
(+ (caddr einfuegepunkt) (caddr (car ks-aus)) (caddr offset))))
(princ (strcat "\n KS_AUS Z=" (rtos (caddr ausgang) 2 2)))
ausgang
)
@@ -1198,9 +1205,12 @@
(setq antwort (getstring "\nEinfuegen? (1=Ja / 2=Nein) [1]: "))
(if (not (= antwort "2"))
(progn
;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern
;; GF-Nummer und Entity-Grenze vor erster Einfuegung sichern.
;; vf-lastent-ohne-attribute ueberspringt Attribut-Entities/SEQEND
;; eines vorherigen GF_N/VF_N-Blocks, sonst rutschen sie in die
;; naechste Blockerstellung hinein.
(setq gf-nummer (gf-next-number))
(setq last-ent (entlast))
(setq last-ent (vf-lastent-ohne-attribute))
;; AUS-Element: KS_EIN so ausrichten, dass KS_AUS in Fahrtrichtung entry-hz zeigt.
;; Beweis: KS_AUS.xu = -yu(target-frame). Fuer KS_AUS||entry-hz gilt:
@@ -1507,7 +1517,7 @@
;; GF-Nummer und Entity-Grenze vor erster Einfuegung
(setq gf-nummer (gf-next-number))
(setq last-ent (entlast))
(setq last-ent (vf-lastent-ohne-attribute))
;; Fahrtrichtungsvektor (KS_AUS-Richtung, Basis fuer Staustrecke/Separator/ES)
(setq rad-hz (* (float hz) (/ pi 180.0)))
@@ -1584,7 +1594,10 @@
(princ "\n\n=========================================")
(princ "\n>>> Gefaellestrecke erfolgreich eingefuegt! <<<")
(princ "\n=========================================")
gf-insert
;; Rueckgabe: (ename echtes-deltaH echtes-deltaL) - volle Fliesskomma-
;; Genauigkeit, unabhaengig von der auf ganze mm gerundeten HOEHE_VON/
;; HOEHE_BIS-Attribut-Darstellung im GF_N-Block.
(list gf-insert gf-deltaH (float deltaL-total))
)
;; ============================================================