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

Vario Kette Merge korrigiert

Browse Source
This commit is contained in:
Yuelin Wang
2026-07-29 08:48:03 +02:00
parent 3e23003b24
commit 006b0ed084
1 changed files with 136 additions and 149 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/vf_linienzug.lsp
+136 -149
View File
@@ -2774,6 +2774,14 @@
;; KS_EIN/KS_AUS (auch Umlenk-/Motorstation, Vertikalboegen, das gestreckte
;; Zwischenstueck und der Separator) - die Verkettung laeuft daher komplett
;; ueber KS-Nachbarschaft, keine Bounding-Box-Geometrie noetig.
;;
;; Ein angetroffener VF_n-Wrapper wird beim Erfassen SOFORT (temporaer) in
;; seine Sub-Elemente aufgeloest, die dann wie von Anfang an lose Bauteile
;; behandelt werden (vfl-kette-sammle-alle) - eine fruehere Fassung versuchte
;; stattdessen, fuer einen Wrapper EINEN Gesamt-KS_EIN/KS_AUS per "welcher
;; Punkt hat kein Gegenstueck"-Heuristik zu bestimmen; das schlug bei langen
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl (siehe
;; [[project_vario_kette_merge]] Update 6).
;; Toleranzen (mm) fuer die Nachbarschaftspruefung zwischen zwei Bausteinen:
;; <= tol-eng -> gilt als sauber verbunden, Kette geht weiter
@@ -2783,13 +2791,15 @@
(if (null *vfl-kette-tol-weit*) (setq *vfl-kette-tol-weit* 100.0))
;; Kleine Feld-Zugriffe auf einen Ketten-Datensatz
;; (ename bname ks-ein-punkt ks-aus-punkt attribute-alist ist-wrapper)
;; (ename bname ks-ein-punkt ks-aus-punkt wrapper-ename)
;; ename = nil und wrapper-ename gesetzt: Sub-Element eines aufgeloesten
;; VF_n-Wrappers (wrapper-ename = dessen Original-Ename). Sonst: eigenstaen-
;; diges Bauteil (ename gesetzt, wrapper-ename nil).
(defun vfl-kette-rec-ename (rec) (nth 0 rec))
(defun vfl-kette-rec-bname (rec) (nth 1 rec))
(defun vfl-kette-rec-ein (rec) (nth 2 rec))
(defun vfl-kette-rec-aus (rec) (nth 3 rec))
(defun vfl-kette-rec-attribs (rec) (nth 4 rec))
(defun vfl-kette-rec-wrapper (rec) (nth 5 rec))
(defun vfl-kette-rec-wrapper (rec) (nth 4 rec))
;; String an einem Trennzeichen aufteilen (reine Teilstring-Suche, keine
;; Wildcards). Bei "_"-Trennung eines Bausteinnamens liefert das die
@@ -2805,8 +2815,6 @@
(append ergebnis (list rest))
)
(defun vfl-kette-teil (bname idx) (nth idx (vfl-kette-split bname "_")))
(defun vfl-kette-split-komma (str)
(if (and str (> (strlen str) 0)) (vfl-kette-split str ",") '()))
;; Bausteintyp aus dem Blocknamen ableiten. Scanner/Separator_SP (manuelle
;; Sensor-Bloecke, siehe count_sep_scan.lsp) gehoeren NICHT zur Kette selbst
@@ -2837,14 +2845,6 @@
)
(defun vfl-kette-round (x) (atoi (rtos x 2 0)))
;; Attribut-Wert als Zahl/Text lesen (Default falls Tag fehlt/leer).
(defun vfl-kette-attrib-zahl (attribs tag / w)
(setq w (cdr (assoc tag attribs)))
(if w (atoi w) 0))
(defun vfl-kette-attrib-text (attribs tag default / w)
(setq w (cdr (assoc tag attribs)))
(if (and w (> (strlen w) 0)) w default))
;; Attribut-Wert auf "" erzwingen. ssg-attrib-set-on ueberspringt leere Werte
;; bewusst als "keine Ueberschreibung" (ATTDEF-Default bleibt stehen) - hier
;; soll das Feld aber ABSICHTLICH geleert werden (z.B. SEITE_AS/SEITE_ES,
@@ -2908,59 +2908,22 @@
ergebnis
)
;; Gesamt-KS_EIN (erster Baustein) und Gesamt-KS_AUS (letzter Baustein) EINES
;; Bausteins ermitteln + Kennzeichen ob es sich um einen Wrapper handelt.
;; Zuerst DIREKT versucht (Leaf-Element - traegt selbst KS_EIN/KS_AUS als
;; Sub-Block, siehe vfl-kette-ks-ursprung). Liefert die direkte Suche NICHTS
;; (leer), wird block-obj als Wrapper (bereits gemergter VF_n) behandelt:
;; eine Ebene tiefer je Sub-Element gesucht, intern zusammenhaengende Punkte
;; herausgefiltert.
;; Rueckgabe: (list ks-ein ks-aus ist-wrapper).
(defun vfl-kette-block-ks-punkte (block-obj / direkt kinder kind sub-ks
ein-liste aus-liste ergebnis-ein ergebnis-aus p q match)
(setq direkt (vfl-kette-ks-ursprung block-obj))
(if direkt
(list
(cdr (assoc "KS_EIN" direkt))
(cdr (assoc "KS_AUS" direkt))
nil
)
(progn
(setq kinder (vlax-invoke block-obj 'Explode))
(setq ein-liste '() aus-liste '())
(foreach kind kinder
(if (and (not (vlax-erased-p kind))
(= (vla-get-ObjectName kind) "AcDbBlockReference"))
(progn
(setq sub-ks (vfl-kette-ks-ursprung kind))
(if (assoc "KS_EIN" sub-ks) (setq ein-liste (cons (cdr (assoc "KS_EIN" sub-ks)) ein-liste)))
(if (assoc "KS_AUS" sub-ks) (setq aus-liste (cons (cdr (assoc "KS_AUS" sub-ks)) aus-liste)))
)
)
)
(foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind)))
(setq ergebnis-ein nil)
(foreach p ein-liste
(setq match nil)
(foreach q aus-liste (if (< (distance p q) *vfl-kette-tol-eng*) (setq match T)))
(if (not match) (setq ergebnis-ein p))
)
(setq ergebnis-aus nil)
(foreach p aus-liste
(setq match nil)
(foreach q ein-liste (if (< (distance p q) *vfl-kette-tol-eng*) (setq match T)))
(if (not match) (setq ergebnis-aus p))
)
(list ergebnis-ein ergebnis-aus T)
)
)
)
;; Alle Vario-Kette-Bausteine der Zeichnung einsammeln (lose Einzelteile UND
;; bereits gewickelte VF_n - siehe vfl-kette-typ): Attribute (nur bei
;; Wrappern vorhanden, VOR jeder Veraenderung gelesen), Gesamt-KS_EIN/KS_AUS
;; und Wrapper-Kennzeichen je Baustein.
(defun vfl-kette-sammle-alle ( / ss i ename bname attribs obj ks-info records)
;; die Sub-Elemente bereits gewickelter VF_n - siehe vfl-kette-typ). Ein
;; angetroffener VF_n-Wrapper wird SOFORT (temporaer) in seine Sub-Elemente
;; aufgeloest und JEDES Sub-Element als eigener Datensatz mit direkt lesbarem
;; KS_EIN/KS_AUS erfasst - keine "welcher Punkt hat kein Gegenstueck"-
;; Heuristik fuer einen Gesamt-Punkt mehr noetig (die schlug bei langen
;; bestehenden Ketten durch akkumulierte Rundungsungenauigkeit fehl, siehe
;; [[project_vario_kette_merge]]). Die Kettenverfolgung faedelt die
;; Sub-Elemente danach ueber ihre echten KS-Punkte in der richtigen
;; Reihenfolge auf - unabhaengig von der Explode-Reihenfolge.
;; ename = nil fuer ein Sub-Element eines Wrappers (die temporaere
;; Explode-Kopie wurde bereits wieder geloescht); wrapper-ename identifiziert
;; in diesem Fall den ORIGINAL-Wrapper (fuer den finalen Merge-Schritt).
;; Rueckgabe: Liste von (ename bname ein aus wrapper-ename).
(defun vfl-kette-sammle-alle ( / ss i ename bname typ obj kinder kind
sub-ks child-bname child-ks records)
(setq records '())
(setq ss (ssget "X" '((0 . "INSERT"))))
(if ss
@@ -2969,12 +2932,37 @@
(while (< i (sslength ss))
(setq ename (ssname ss i))
(setq bname (cdr (assoc 2 (entget ename))))
(if (/= (vfl-kette-typ bname) "UNBEKANNT")
(progn
(setq attribs (ssg-attrib-read ename))
(setq typ (vfl-kette-typ bname))
(cond
((= typ "WRAPPER")
(setq obj (vlax-ename->vla-object ename))
(setq ks-info (vfl-kette-block-ks-punkte obj))
(setq records (cons (list ename bname (car ks-info) (cadr ks-info) attribs (caddr ks-info)) records))
(setq kinder (vlax-invoke obj 'Explode))
(foreach kind kinder
(if (and (not (vlax-erased-p kind))
(= (vla-get-ObjectName kind) "AcDbBlockReference"))
(progn
(setq child-bname (vla-get-Name kind))
(setq child-ks (vfl-kette-ks-ursprung kind))
(setq records
(cons (list nil child-bname
(cdr (assoc "KS_EIN" child-ks))
(cdr (assoc "KS_AUS" child-ks))
ename)
records))
)
)
)
(foreach kind kinder (if (not (vlax-erased-p kind)) (vla-Delete kind)))
)
((/= typ "UNBEKANNT")
(setq obj (vlax-ename->vla-object ename))
(setq sub-ks (vfl-kette-ks-ursprung obj))
(setq records
(cons (list ename bname
(cdr (assoc "KS_EIN" sub-ks))
(cdr (assoc "KS_AUS" sub-ks))
nil)
records))
)
)
(setq i (1+ i))
@@ -3008,12 +2996,20 @@
;; Kandidaten - Diagnose-Hilfe, wenn die Kette bei Laenge 1
;; endet (dann kein warnung, aber evtl. trotzdem ein Fund
;; ausserhalb von tol-weit).
(defun vfl-kette-verfolgen (start-rec alle-records / rest kette aktuell fund fertig warnung letzter-fund)
;; verdaechtig = Liste (vorgaenger-bname naechster-bname abstand) fuer jeden
;; Anschluss, dessen Abstand > 0.5mm war - eine echte, absichtlich
;; gebaute KS-zu-KS-Verbindung sollte praktisch bei 0mm liegen;
;; ein spuerbarer (aber noch innerhalb tol-eng liegender)
;; Abstand deutet auf eine ZUFAELLIG nahe, aber NICHT wirklich
;; zusammengehoerige Stelle hin (z.B. zwei unabhaengige Linien,
;; die im Layout nahe beieinander liegen/sich kreuzen).
(defun vfl-kette-verfolgen (start-rec alle-records / rest kette aktuell fund fertig warnung letzter-fund verdaechtig)
(setq rest (vl-remove start-rec alle-records))
(setq kette (list start-rec))
(setq aktuell start-rec)
(setq warnung nil)
(setq letzter-fund nil)
(setq verdaechtig '())
(setq fertig nil)
(while (not fertig)
(setq fund (vfl-kette-naechster (vfl-kette-rec-aus aktuell) rest))
@@ -3021,6 +3017,8 @@
(cond
((null fund) (setq fertig T))
((<= (cdr fund) *vfl-kette-tol-eng*)
(if (> (cdr fund) 0.5)
(setq verdaechtig (cons (list (vfl-kette-rec-bname aktuell) (vfl-kette-rec-bname (car fund)) (cdr fund)) verdaechtig)))
(setq aktuell (car fund))
(setq kette (append kette (list aktuell)))
(setq rest (vl-remove aktuell rest))
@@ -3033,21 +3031,22 @@
(t (setq fertig T))
)
)
(list kette warnung letzter-fund)
(list kette warnung letzter-fund verdaechtig)
)
;; Attribute des neuen Gesamt-Blocks aus der gefundenen Bausteinfolge
;; herleiten: dieselben Akkumulatoren (vfl-acc-*) wie beim interaktiven Bau,
;; hier rueckwirkend anhand der Bausteinfolge gefuellt statt waehrend des
;; Bauens. Bereits gewickelte VF_n-Bausteine werden mit ihren VORHANDENEN
;; Attributen eingespeist (Komma-Listen aufgeteilt/angehaengt, Zaehler
;; addiert) - so lassen sich lose Einzelteile und fertige VF_n beliebig
;; mischen. chain-start/chain-end = Gesamt-KS_EIN/KS_AUS der ganzen Kette
;; (Welt-Z liefert Hoehe-von/-bis direkt, kein erneutes Auslesen noetig).
;; Bauens. Sub-Elemente eines bereits gewickelten VF_n wurden beim Erfassen
;; (vfl-kette-sammle-alle) bereits aufgeloest und durchlaufen hier dieselbe
;; Typ-Klassifikation wie von Anfang an lose Bauteile - lose Einzelteile und
;; fertige VF_n lassen sich dadurch beliebig mischen. chain-start/chain-end =
;; Gesamt-KS_EIN/KS_AUS der ganzen Kette (Welt-Z liefert Hoehe-von/-bis
;; direkt, kein erneutes Auslesen noetig).
;; Rueckgabe: (list attribut-alist typ-str).
(defun vfl-kette-baue-attribute (kette neuer-bname chain-start chain-end /
rec typ bname anzahl-vf phase entry-info gemessen betrag richtung
as-seite es-seite w-attribs tag n delta-l erster letzter ergebnis typ-str)
as-seite es-seite delta-l erster letzter ergebnis typ-str)
(vfl-acc-reset)
(setq anzahl-vf 0)
(setq phase "gf")
@@ -3067,27 +3066,10 @@
(setq delta-l (+ delta-l (distance (vfl-kette-rec-ein rec) (vfl-kette-rec-aus rec)))))
(cond
;; --- Bereits gewickelter VF_n: fertige Attribute direkt einspeisen ---
((vfl-kette-rec-wrapper rec)
(setq w-attribs (vfl-kette-rec-attribs rec))
(setq *vfl-acc-lgf* (append *vfl-acc-lgf* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "L_GF_m" ""))))
(setq *vfl-acc-gfwinkel* (append *vfl-acc-gfwinkel* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "GF_WINKEL" ""))))
(setq *vfl-acc-lvf* (append *vfl-acc-lvf* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "L_VF_m" ""))))
(setq *vfl-acc-winkel* (append *vfl-acc-winkel* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "VF_WINKEL" ""))))
(setq *vfl-acc-richtung* (append *vfl-acc-richtung* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "ANTRIEBFAHRTRICHTUNG" ""))))
(setq *vfl-acc-motorseite* (append *vfl-acc-motorseite* (vfl-kette-split-komma (vfl-kette-attrib-text w-attribs "MOTORSEITE" ""))))
(foreach tag '("L_90" "L_60" "L_30" "R_90" "R_60" "R_30")
(setq n (vfl-kette-attrib-zahl w-attribs (strcat "GF_Bogen_" tag)))
(repeat n (setq *vfl-acc-gfbogen* (vfl-inc-count *vfl-acc-gfbogen* tag))))
(foreach tag '("A_90" "A_60" "A_30" "I_90" "I_60" "I_30")
(setq n (vfl-kette-attrib-zahl w-attribs (strcat "VF_Bogen_" tag)))
(repeat n (setq *vfl-acc-variokurve* (vfl-inc-count *vfl-acc-variokurve* tag))))
(setq *vfl-acc-separator* (+ *vfl-acc-separator* (vfl-kette-attrib-zahl w-attribs "ANZAHL_SEPARATOR")))
(setq anzahl-vf (+ anzahl-vf (vfl-kette-attrib-zahl w-attribs "ANZAHL_VF")))
(if (equal rec erster) (setq as-seite (vfl-kette-attrib-text w-attribs "SEITE_AS" "")))
(if (equal rec letzter) (setq es-seite (vfl-kette-attrib-text w-attribs "SEITE_ES" "")))
)
;; Wrapper-Records gibt es nicht mehr - ein angetroffener VF_n wurde
;; bereits beim Erfassen (vfl-kette-sammle-alle) in seine Sub-Elemente
;; aufgeloest; jedes davon durchlaeuft hier dieselbe Typ-Klassifikation
;; wie ein von Anfang an loses Bauteil.
((= typ "AS")
(if (equal rec erster) (setq as-seite (vfl-kette-teil bname 3))))
@@ -3195,9 +3177,11 @@
)
(defun c:Vario_Kette_Merge ( / sel start-ename start-bname alle-records start-rec
lauf kette warnung naechster-fund merge-ss leaf-enames chain-start chain-end neuer-bname
rec kinder kind diag-obj diag-kinder erg aggregiert typ-str neuer-insert def
leaf-ename leaf-obj leaf-noch-da)
start-obj start-ins kandidaten bester-d d r
lauf kette warnung naechster-fund merge-ss leaf-enames aufgeloeste-wrapper
chain-start chain-end neuer-bname
rec kinder kind erg aggregiert typ-str neuer-insert def
leaf-ename leaf-obj leaf-noch-da verdaechtig v)
(ssg-start "Vario_Kette_Merge" nil)
(princ (ssg-text "vfl-kette-titel"))
(setq sel (entsel (ssg-text "vfl-kette-start-waehlen")))
@@ -3212,19 +3196,28 @@
(setq alle-records (vfl-kette-sammle-alle))
;; DIAGNOSE: fuer jede erfasste Staustrecke_SP_1000_mm* zeigen, ob KS_EIN/
;; KS_AUS gefunden wurden (Verdachtsfall aus vorherigen Tests).
(foreach rec alle-records
(if (= (vfl-kette-typ (vfl-kette-rec-bname rec)) "STRECKE")
(princ (strcat "\n [Diagnose] " (vfl-kette-rec-bname rec)
" KS_EIN=" (if (vfl-kette-rec-ein rec) "gefunden" "FEHLT")
" KS_AUS=" (if (vfl-kette-rec-aus rec) "gefunden" "FEHLT")
" wrapper=" (if (vfl-kette-rec-wrapper rec) "ja" "nein")))
)
)
(setq start-rec nil)
(foreach rec alle-records (if (equal (vfl-kette-rec-ename rec) start-ename) (setq start-rec rec)))
(if (and (null start-rec) (= (vfl-kette-typ start-bname) "WRAPPER"))
(progn
;; Nutzer hat einen VF_n-Wrapper direkt gewaehlt - der wurde beim
;; Erfassen bereits in seine Sub-Elemente aufgeloest (keins davon
;; traegt mehr diesen ename). Das Sub-Element mit KS_EIN am naechsten
;; zum InsertionPoint des Wrappers gilt als dessen Kettenanfang - das
;; ist per Bauart (ssg-block-wrap-welt bekommt immer den Kettenanfang
;; als Basispunkt) exakt der richtige Punkt.
(setq start-obj (vlax-ename->vla-object start-ename))
(setq start-ins (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint start-obj))))
(setq kandidaten (vl-remove-if-not
(function (lambda (r) (and (equal (vfl-kette-rec-wrapper r) start-ename) (vfl-kette-rec-ein r))))
alle-records))
(setq bester-d nil)
(foreach r kandidaten
(setq d (distance start-ins (vfl-kette-rec-ein r)))
(if (or (null bester-d) (< d bester-d)) (progn (setq start-rec r) (setq bester-d d)))
)
)
)
(if (null start-rec)
(progn
(princ (ssg-textf "vfl-kette-start-nicht-gefunden-diag"
@@ -3240,6 +3233,7 @@
(setq kette (car lauf))
(setq warnung (cadr lauf))
(setq naechster-fund (caddr lauf))
(setq verdaechtig (nth 3 lauf))
(if (< (length kette) 2)
(progn
@@ -3261,9 +3255,19 @@
(if warnung
(princ (ssg-textf "vfl-kette-luecke-warnung"
(list (car warnung) (cadr warnung) (rtos (caddr warnung) 2 1)))))
;; DIAGNOSE: Anschluesse mit spuerbarem (>0.5mm), aber noch innerhalb
;; tol-eng liegendem Abstand - Verdacht auf zufaellig nahe, aber nicht
;; wirklich zusammengehoerige Bauteile (z.B. zwei unabhaengige Linien, die
;; im Layout nahe beieinander liegen).
(if verdaechtig
(foreach v verdaechtig
(princ (strcat "\n [Diagnose] VERDAECHTIG: '" (car v) "' -> '" (cadr v)
"' Abstand=" (rtos (caddr v) 2 3) " mm (innerhalb Toleranz, aber nicht ~0)")))
)
;; Attribute + Kettenanfang/-ende VOR dem Explodieren sichern (Attribute
;; eines Wrappers gehen beim Explodieren verloren - werden zu wertlosem Text).
;; Attribute aus der Bausteinfolge herleiten, bevor irgendetwas an der
;; Zeichnung veraendert wird (chain-start/chain-end kommen aus dem ersten/
;; letzten Datensatz in kette).
(setq neuer-bname (strcat "VF_" (itoa (vf-next-number))))
(setq chain-start (vfl-kette-rec-ein (car kette)))
(setq chain-end (vfl-kette-rec-aus (car (reverse kette))))
@@ -3271,9 +3275,11 @@
(setq aggregiert (car erg))
(setq typ-str (cadr erg))
;; Wrapper (bereits gemergte VF_n) explodieren (Sub-Elemente bleiben als
;; Bloecke erhalten, ATTRIB-Textreste werden verworfen), Original loeschen.
;; Lose Einzel-Bausteine werden unveraendert direkt uebernommen (_.-BLOCK
;; Aufgeloeste Wrapper-Sub-Elemente: der ORIGINAL-Wrapper wird (einmal je
;; distinktem wrapper-ename, da er i.d.R. mehrere Sub-Element-Datensaetze
;; in kette beisteuert) jetzt fuer REAL explodiert - Sub-Elemente bleiben
;; als Bloecke erhalten, ATTRIB-Textreste werden verworfen, Original
;; geloescht. Lose Einzel-Bausteine werden unveraendert direkt uebernommen (_.-BLOCK
;; unten SOLLTE sie beim Wickeln konsumieren, wie bei frisch gebauter
;; Geometrie - leaf-enames wird trotzdem mitgefuehrt, um sie nach dem
;; Wickeln sicherheitshalber explizit zu entfernen, falls _.-BLOCK sie aus
@@ -3281,29 +3287,25 @@
;; Geometrie waere sonst die Folge).
(setq merge-ss (ssadd))
(setq leaf-enames '())
(setq aufgeloeste-wrapper '())
(foreach rec kette
(if (vfl-kette-rec-wrapper rec)
(progn
(setq kinder (vlax-invoke (vlax-ename->vla-object (vfl-kette-rec-ename rec)) 'Explode))
(foreach kind kinder
(if (not (vlax-erased-p kind))
(if (= (vla-get-ObjectName kind) "AcDbBlockReference")
(ssadd (vlax-vla-object->ename kind) merge-ss)
(vla-Delete kind)
(if (not (member (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
(progn
(setq aufgeloeste-wrapper (cons (vfl-kette-rec-wrapper rec) aufgeloeste-wrapper))
(setq kinder (vlax-invoke (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)) 'Explode))
(foreach kind kinder
(if (not (vlax-erased-p kind))
(if (= (vla-get-ObjectName kind) "AcDbBlockReference")
(ssadd (vlax-vla-object->ename kind) merge-ss)
(vla-Delete kind)
)
)
)
(vla-Delete (vlax-ename->vla-object (vfl-kette-rec-wrapper rec)))
)
(vla-Delete (vlax-ename->vla-object (vfl-kette-rec-ename rec)))
)
(progn
;; DIAGNOSE: Skalierung unmittelbar VOR dem Einwickeln pruefen (grenzt
;; ein, ob eine evtl. Verzerrung schon vor _.-BLOCK/_.INSERT entsteht).
(setq diag-obj (vlax-ename->vla-object (vfl-kette-rec-ename rec)))
(princ (strcat "\n [Diagnose] " (vfl-kette-rec-bname rec)
" vor dem Wickeln: XScale="
(rtos (vla-get-XScaleFactor diag-obj) 2 4)
" YScale=" (rtos (vla-get-YScaleFactor diag-obj) 2 4)
" ZScale=" (rtos (vla-get-ZScaleFactor diag-obj) 2 4)))
(setq leaf-enames (cons (vfl-kette-rec-ename rec) leaf-enames))
(ssadd (vfl-kette-rec-ename rec) merge-ss)
)
@@ -3335,21 +3337,6 @@
(if (= (cdr (assoc "SEITE_ES" aggregiert)) "") (vfl-kette-attrib-leeren neuer-insert "SEITE_ES"))
(if (car (atoms-family 1 '("SSG-ID-GENERATE"))) (ssg-id-generate neuer-insert))
;; DIAGNOSE: Skalierung der verschachtelten Bausteine NACH dem Wickeln
;; pruefen (temporaerer Explode einer Kopie, sofort wieder geloescht -
;; neuer-insert selbst bleibt unveraendert). Grenzt ein, ob eine
;; Verzerrung erst durch _.-BLOCK/_.INSERT entsteht.
(setq diag-kinder (vlax-invoke (vlax-ename->vla-object neuer-insert) 'Explode))
(foreach diag-obj diag-kinder
(if (and (not (vlax-erased-p diag-obj)) (= (vla-get-ObjectName diag-obj) "AcDbBlockReference"))
(princ (strcat "\n [Diagnose] " (vla-get-Name diag-obj)
" nach dem Wickeln: XScale=" (rtos (vla-get-XScaleFactor diag-obj) 2 4)
" YScale=" (rtos (vla-get-YScaleFactor diag-obj) 2 4)
" ZScale=" (rtos (vla-get-ZScaleFactor diag-obj) 2 4)))
)
)
(foreach diag-obj diag-kinder (if (not (vlax-erased-p diag-obj)) (vla-Delete diag-obj)))
;; Sicherheitsnetz: lose Einzelteile, die _.-BLOCK aus irgendeinem Grund NICHT
;; aus dem Modellraum entfernt hat, jetzt explizit loeschen - verhindert
;; doppelte/ueberlappende Geometrie (altes Original + neuer Gesamt-Block).