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

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

Browse Source
This commit is contained in:
Yuelin Wang
2026-07-02 10:12:30 +02:00
parent b915980540
commit 11555ace8e
4 changed files with 160 additions and 97 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/Gefaellestrecke.lsp
+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))
)
;; ============================================================
Lisp/vf_core.lsp
+72 -40
View File
@@ -427,7 +427,7 @@
;; ============================================================
;; TEIL 8: BLOCK-EINFUEGEFUNKTIONEN (gemeinsam fuer alle Typen)
;; ============================================================
(defun insert-block-by-ks (blockname einfuegepunkt / block-obj ks-data ks-ein ks-aus offset ausgang)
(defun insert-block-by-ks (blockname einfuegepunkt / block-obj temp-obj ks-data ks-ein ks-aus offset ausgang)
(if (or (null einfuegepunkt) (not (listp einfuegepunkt)))
(progn
(princ (strcat "\n FEHLER: Ungueltiger Einfuegepunkt fuer '" blockname "'"))
@@ -442,23 +442,32 @@
)
)
(princ (strcat "\n Fuege Block '" blockname "' ein..."))
;; KS_EIN/KS_AUS ueber eigenes Temp-Objekt am Ursprung ermitteln (nicht am
;; spaeter tatsaechlich platzierten block-obj - extract-ks-from-block
;; exploded das uebergebene Objekt intern), siehe insert-block-ks-to-ks.
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point einfuegepunkt)
blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block block-obj))
(setq ks-ein (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus (cadr (assoc "KS_AUS" ks-data)))
(if (and ks-ein ks-aus)
(progn
(setq offset (list (- (car einfuegepunkt) (car (car ks-ein)))
(- (cadr einfuegepunkt) (cadr (car ks-ein)))
(- (caddr einfuegepunkt) (caddr (car ks-ein)))))
;; offset verschiebt block-obj so, dass KS_EIN (aktuell bei
;; einfuegepunkt+lokalerVersatz) exakt auf einfuegepunkt zu liegen kommt.
(setq offset (list (- (car (car ks-ein)))
(- (cadr (car ks-ein)))
(- (caddr (car ks-ein)))))
(vla-Move block-obj
(vlax-3D-point (car ks-ein))
(vlax-3D-point einfuegepunkt))
(setq ausgang (list (+ (car (car ks-aus)) (car offset))
(+ (cadr (car ks-aus)) (cadr offset))
(+ (caddr (car ks-aus)) (caddr offset))))
(vlax-3D-point '(0 0 0))
(vlax-3D-point offset))
(setq ausgang (list (+ (car einfuegepunkt) (car (car ks-aus)) (car offset))
(+ (cadr einfuegepunkt) (cadr (car ks-aus)) (cadr offset))
(+ (caddr einfuegepunkt) (caddr (car ks-aus)) (caddr offset))))
(princ (strcat "\n KS_AUS: X=" (rtos (car ausgang) 2 2)
" Z=" (rtos (caddr ausgang) 2 2)))
ausgang
@@ -474,7 +483,7 @@
;; target-frame : (P xt yt zt) - Ziel-Rahmen, z.B. KS_AUS des Vorgaenger-Elements
;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks
(defun insert-block-ks-to-ks (blockname target-frame /
block-obj ks-data ks-ein-raw ks-aus-raw
block-obj temp-obj ks-data ks-ein-raw ks-aus-raw
f-ein f-aus P-t xt yt zt
P-ein xe ye ze P-aus xu-aus yu-aus zu-aus
R R-Pein R-Paus tx ty tz T4
@@ -489,19 +498,26 @@
xt (cadr target-frame)
yt (caddr target-frame)
zt (cadddr target-frame))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
;; KS_EIN und KS_AUS extrahieren (nutzt Cache nach erstem Aufruf)
(setq ks-data (extract-ks-from-block block-obj))
;; KS_EIN/KS_AUS ueber EIGENES Temp-Objekt ermitteln (nicht am spaeter
;; tatsaechlich platzierten block-obj - extract-ks-from-block exploded
;; das uebergebene Objekt intern; das darf nicht das Objekt sein, das
;; anschliessend transformiert in der Zeichnung bleibt).
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
(if (not (and ks-ein-raw ks-aus-raw))
(progn
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'"))
(vla-Delete block-obj)
(exit)))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
;; bleibt tatsaechlich in der Zeichnung.
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
(setq f-ein (ks-frame-extract ks-ein-raw)
f-aus (ks-frame-extract ks-aus-raw))
@@ -557,7 +573,7 @@
;; z-ziel : gewuenschte Welt-Z-Koordinate des z-ref-Punktes
;; Rueckgabe : (P xu yu zu) - KS_AUS-Rahmen des eingefuegten Blocks
(defun insert-block-mixed-to-ks (blockname target-frame z-ziel xy-ref z-ref /
block-obj ks-data ks-ein-raw ks-aus-raw
block-obj temp-obj ks-data ks-ein-raw ks-aus-raw
f-ein f-aus P-t xt yt zt
xe ye ze P-ein P-aus xu-aus yu-aus zu-aus
R P-xyref P-zref R-xyref R-zref tx ty tz T4
@@ -572,19 +588,26 @@
xt (cadr target-frame)
yt (caddr target-frame)
zt (cadddr target-frame))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1)
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
;; KS_EIN und KS_AUS extrahieren (nutzt Cache nach erstem Aufruf)
(setq ks-data (extract-ks-from-block block-obj))
;; KS_EIN/KS_AUS ueber EIGENES Temp-Objekt ermitteln (nicht am spaeter
;; tatsaechlich platzierten block-obj - extract-ks-from-block exploded
;; das uebergebene Objekt intern; das darf nicht das Objekt sein, das
;; anschliessend transformiert in der Zeichnung bleibt).
(setq temp-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
(setq ks-data (extract-ks-from-block temp-obj))
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
(setq ks-ein-raw (cadr (assoc "KS_EIN" ks-data)))
(setq ks-aus-raw (cadr (assoc "KS_AUS" ks-data)))
(if (not (and ks-ein-raw ks-aus-raw))
(progn
(princ (strcat "\n FEHLER: KS_EIN/KS_AUS fehlen in '" blockname "'"))
(vla-Delete block-obj)
(exit)))
;; Block am Ursprung einfuegen (Rotation=0, Massstab=1) - dieses Objekt
;; bleibt tatsaechlich in der Zeichnung.
(setq block-obj (vla-InsertBlock modelspace
(vlax-3D-point '(0 0 0))
blockname 1.0 1.0 1.0 0))
;; Normierte Rahmen (P xu yu zu) aus rohen KS-Daten berechnen
(setq f-ein (ks-frame-extract ks-ein-raw)
f-aus (ks-frame-extract ks-aus-raw))
@@ -858,6 +881,26 @@
))
)
;; Ermittelt den "letzten Entity" VOR einer neuen Einfuegung, so dass
;; nachfolgende Attribut-Entities/SEQEND eines vorherigen INSERT (z.B. eines
;; vorangegangenen VF_N-Blocks) nicht versehentlich in die naechste
;; vf-block-erstellen-Sammlung hineinfallen. Muss von JEDEM Aufrufer von
;; vf-block-erstellen anstelle eines nackten (entlast) verwendet werden.
(defun vf-lastent-ohne-attribute ( / ent)
(setq ent (entlast))
(if (and ent
(= (cdr (assoc 0 (entget ent))) "INSERT")
(= (cdr (assoc 66 (entget ent))) 1))
(progn
(setq ent (entnext ent))
(while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND"))
(setq ent (entnext ent))
)
)
)
ent
)
;; Erstellt VF_N-Block aus allen seit lastEnt erzeugten Entities.
;; Setzt Attributwerte entsprechend Typ, Seite und Geometrieparametern.
(defun vf-block-erstellen (anlage-typ seite vf-nummer n-scanner
@@ -1139,18 +1182,7 @@
(t hoehe-von)))
;; lastEnt VOR der Einfuegung merken
(setq lastEnt (entlast))
(if (and lastEnt
(= (cdr (assoc 0 (entget lastEnt))) "INSERT")
(= (cdr (assoc 66 (entget lastEnt))) 1))
(progn
(setq lastEnt (entnext lastEnt))
(while (and lastEnt
(/= (cdr (assoc 0 (entget lastEnt))) "SEQEND"))
(setq lastEnt (entnext lastEnt))
)
)
)
(setq lastEnt (vf-lastent-ohne-attribute))
;; Typ-spezifische Einfuegung
(apply einfuege-fn