From 006b0ed084b459372f6ad051c5d0fde80bc5beda Mon Sep 17 00:00:00 2001 From: Yuelin Wang Date: Wed, 29 Jul 2026 08:48:03 +0200 Subject: [PATCH] Vario Kette Merge korrigiert --- Lisp/vf_linienzug.lsp | 285 ++++++++++++++++++++---------------------- 1 file changed, 136 insertions(+), 149 deletions(-) diff --git a/Lisp/vf_linienzug.lsp b/Lisp/vf_linienzug.lsp index 5d893a2..e346386 100644 --- a/Lisp/vf_linienzug.lsp +++ b/Lisp/vf_linienzug.lsp @@ -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).