Um die Ausmaße einer Zelle (auch als Range bezeichnet) zu berechnen, kann man die VBA Eigenschaft .Range benutzen. Der Datentyp Range beinhaltet 2 Punkte, praktisch die linke untere Ecke und die rechte obere Ecke des kleinsten die Zelle umfassenden Rechtecks.Der Range kann auch im 3D analog berechnet werden, die folgenden Beispiele funktionieren auch im 3D, zur Veranschaulichung hab ich nur alles in 2D dargestellt.
Ein Problem tritt nur auf, sobald Zellen gedreht sind, denn die RangeBox, also das umschreibende Rechteck ist immer orthogonal zur Ansicht, d.h. die Größe verändert sich mit der Drehung.
Um die Problematik aufzuzeigen, zunächst einmal die einfache Vorgehensweise bei ungedrehten Zellen. Betrachten wir folgendes Beipsiel mit zwei Zellen mit den NAmen ZelleA und ZelleB:
Um die Ausmaße dieser Zellen festzustellen, kann man wie erwähnt die Eigenschaft .Range einer Zelle abfragen, hier ein Beispiel, wie man das machen könnte:
Sub range_einfach() Dim rangeBox As Range3d Dim Ee As ElementEnumerator Set Ee = ActiveModelReference.GraphicalElementCache.Scan Do While Ee.MoveNext If Ee.Current.Type = msdElementTypeCellHeader Then Debug.Print "Name der Zelle: " & Ee.Current.AsCellElement.Name rangeBox = Ee.Current.AsCellElement.Range Debug.Print "Breite und Höhe: ", rangeBox.High.x - rangeBox.Low.x, rangeBox.High.y - rangeBox.Low.y End If Loop End Sub
Die Ausgabe könnte ähnlich wies diese aussehen, die Werte für Breite und Höhe sind für beide Zellen gleich, da sie identische Ausmaße haben:
Wenn nun allerdings die ZelleB gedreht wird, ähnlich so:
Dann ändern sich auch die Ergebnisse der Berechnung mit der obigen Routine range_einfach:
D.h. die ZelleB hat durch die Drehung plötzlich durch die Eigenschaft .Range eine andere Größe. Der Grund dafür ist die Rangeberechnung, hier der dargestellte Range über den Keyin "set range;update1":
Um diesen Fehler auszugleichen, kann man für die Berechnung der Ausmaße die Zelle einfach zurückdrehen.Dazu habe ich folgendes Beispiel benutzt:
Sub range_ungedreht() Dim rangeBox As Range3d Dim Rotat As Matrix3d Dim transForm As Transform3d Dim Ee As ElementEnumerator Set Ee = ActiveModelReference.GraphicalElementCache.Scan Do While Ee.MoveNext If Ee.Current.Type = msdElementTypeCellHeader Then Debug.Print "Name der Zelle: " & Ee.Current.AsCellElement.Name ' Zelle ungedreht untersuchen: Rotat = Ee.Current.AsCellElement.Rotation Rotat = Matrix3dInverse(Rotat) transForm = Transform3dFromMatrix3dAndFixedPoint3d(Rotat, Ee.Current.AsCellElement.Origin) Ee.Current.AsCellElement.transForm transForm rangeBox = Ee.Current.AsCellElement.Range Debug.Print "Breite und Höhe: ", rangeBox.High.x - rangeBox.Low.x, rangeBox.High.y - rangeBox.Low.y End If Loop End Sub
Zunächst lese ich die aktuelle Drehung der Zelle aus (.Rotation) und berechne dafür die inverse Matrix (Matrix3dInverse), um die Drehung umzukehren.Aus dieser inversen Matrix erstelle ich eine Transformation (Transform3dFromMatrix3dAndFixedPoint3d) , die ich auf die Zelle anwende (.transForm).
Anschließend erhalte ich bei der Ausführung wieder das erste Ergebnis mit den ungedrehten Zellen:
Interessant dabei ist auch, dass sich an der Zeichnung selber nicht geändert hat, die Drehung der Zellen erfolgte nur im Speicher, die Änderung an den Zellen wurde nicht in der Zeichnung selber gespeichert, ich habe die Änderung über .Rewrite nicht ausgeführt, deshalb keine Änderung.
XXXXXXX(Add links as needed for other relevant Be Communities content.)XXXXXXX