We have discovered a weird behaviour of Microstation when running a VBA code to manipulate shape elements.
The code is designed to change the width of shape elements (ie. the user enters a value in a Userform and then selects the shape element which should be edited).
Sometimes these shape elements are tagged with some information. If this is the case and the user selects the same shape element again and again then the associated tag element "jumps" around the shape element:
Here are some screenshots:
after the first click everything looks fine - the chosen width is applied to the shape element and the tag element is still where it should be (ie. the center of the shape).
When clicking again it jumps out of the shape element ...
Here is the class module which is used to select the elements:
Option Explicit
Option Base 0
' ---------------------------------------------------------------------
Implements IPrimitiveCommandEvents
' ---------------------------------------------------------------------
Private lev As Level
' ---------------------------------------------------------------------
Private Sub IPrimitiveCommandEvents_Cleanup()
End Sub
' ---------------------------------------------------------------------
' _DataPoint stores Point3d placed by user in our array
' ---------------------------------------------------------------------
Private Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal oView As View)
Dim cScanCriteria As New ElementScanCriteria
Dim cElementEnumerator As ElementEnumerator
Dim lev As Level
Set lev = ActiveDesignFile.Levels.Find("DECKENBALKEN")
cScanCriteria.Reset
cScanCriteria.ExcludeAllTypes
cScanCriteria.ExcludeAllLevels
cScanCriteria.IncludeType msdElementTypeShape
If Not lev Is Nothing Then cScanCriteria.IncludeLevel lev
cScanCriteria.IncludeOnlyWithinRange Range3dFromPoint3d(Point)
Set cElementEnumerator = ActiveModelReference.Scan(cScanCriteria)
Do While cElementEnumerator.MoveNext
With Balkenmanipulation
If .ob_rechtsbündig.Value = True Then
Deckenbalken_Querschnitt_ändern cElementEnumerator.Current.AsShapeElement, .tb_Breite_neu, 1
ElseIf .ob_linksbündig.Value = True Then
Deckenbalken_Querschnitt_ändern cElementEnumerator.Current.AsShapeElement, .tb_Breite_neu, 2
Else
Deckenbalken_Querschnitt_ändern cElementEnumerator.Current.AsShapeElement, .tb_Breite_neu, 3
End If
End With
Loop
' Leimbinder
Set lev = ActiveDesignFile.Levels.Find("DECKENELEMENTIERUNG_LEIMBINDER")
If lev Is Nothing Then Exit Sub
cScanCriteria.Reset
cScanCriteria.ExcludeAllTypes
cScanCriteria.ExcludeAllLevels
cScanCriteria.IncludeType msdElementTypeCellHeader
cScanCriteria.IncludeLevel lev
cScanCriteria.IncludeOnlyWithinRange Range3dFromPoint3d(Point)
Set cElementEnumerator = ActiveModelReference.Scan(cScanCriteria)
Do While cElementEnumerator.MoveNext
With Balkenmanipulation
If .ob_rechtsbündig.Value = True Then
Leimbinder_Querschnitt_ändern cElementEnumerator.Current.AsCellElement, .tb_Breite_neu, 1
ElseIf .ob_linksbündig.Value = True Then
Leimbinder_Querschnitt_ändern cElementEnumerator.Current.AsCellElement, .tb_Breite_neu, 2
Else
Leimbinder_Querschnitt_ändern cElementEnumerator.Current.AsCellElement, .tb_Breite_neu, 3
End If
End With
Loop
End Sub
' ---------------------------------------------------------------------
' _Dynamics: draw shape using point array and current cursor location
' ---------------------------------------------------------------------
Private Sub IPrimitiveCommandEvents_Dynamics(Point As Point3d, ByVal oView As View, ByVal DrawMode As MsdDrawingMode)
End Sub
' -------------------------------------------------------
Private Sub IPrimitiveCommandEvents_Keyin(ByVal Keyin As String)
End Sub
' ---------------------------------------------------------------------
' When user resets, create a shape from our point array
' ---------------------------------------------------------------------
Private Sub IPrimitiveCommandEvents_Reset()
CommandState.SetLocateCursor
CommandState.StartDefaultCommand
ShowCommand ""
ShowPrompt ""
Balkenmanipulation.Show
End Sub
' ---------------------------------------------------------------------
' Command starts here
' ---------------------------------------------------------------------
Private Sub IPrimitiveCommandEvents_Start()
Accudraw_Einstellungen
Set lev = ActiveDesignFile.Levels.Find("DECKENBALKEN")
lev.IsDisplayedInView(ActiveDesignFile.Views(1)) = True
Set lev = ActiveDesignFile.Levels.Find("DECKENELEMENTIERUNG_LEIMBINDER")
If Not lev Is Nothing Then
lev.IsDisplayedInView(ActiveDesignFile.Views(1)) = True
End If
ShowCommand "Balkenquerschnitt ändern"
ShowPrompt "Balken auswählen"
End Sub
Sub Deckenbalken_Querschnitt_ändern(Balken As ShapeElement, Breite_neu As Double, Ausrichtung As Long)
Dim cScanCriteria As New ElementScanCriteria
Dim cElementEnumerator As ElementEnumerator
Dim cIntersectEnumerator As ElementEnumerator
Dim cDiffEnumerator As ElementEnumerator
Dim Balken_neu As ShapeElement
Dim bGeprüft As Boolean
Dim bLöschen As Boolean
Dim Winkel As Double
Dim Breite_alt As Double
Dim Vert() As Point3d
Dim X As Long
' Initialisierung "bGeprüft"
bGeprüft = False
' Winkel & Breite des Balkens wird ermittelt
Winkel = Balkenwinkel_Ermittlung(Balken)
Breite_alt = Balken_Breite(Balken)
Winkel = Round(Winkel, 3)
' Eckpunkte des Balkens werden bestimmt
Vert = Balken.GetVertices
'
If Point3dEqual(Vert(LBound(Vert)), Vert(UBound(Vert))) = True Then
ReDim Preserve Vert(UBound(Vert) - 1)
End If
' Je nach Winkel wird festgelegt, welcher Eckpunkt verändert werden muss
If Abs(Winkel) = 90 Or Abs(Winkel) = 270 Then
For X = LBound(Vert) To UBound(Vert)
' Ausrichtung 1 = rechtsbündig Rechte Kante des Balkens bleibt bestehen
If Ausrichtung = 1 Then
If Vert(X).X < Balken.Centroid.X Then
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), (Breite_neu - Breite_alt), 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), 2 * (Breite_neu - Breite_alt), 0)
End If
End If
End If
' Ausrichtung 2 = linksbündig Links Kante des Balkens bleibt bestehen
ElseIf Ausrichtung = 2 Then
If Vert(X).X > Balken.Centroid.X Then
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), (Breite_neu - Breite_alt), 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), 2 * (Breite_neu - Breite_alt), 0)
End If
End If
End If
' Ausrichtung 3 = Balken wird in beide Richtungen verändert
ElseIf Ausrichtung = 3 Then
If Vert(X).X > Balken.Centroid.X Then
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), (Breite_neu - Breite_alt) / 2, 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), (Breite_neu - Breite_alt), 0)
End If
End If
Else
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), (Breite_neu - Breite_alt) / 2, 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), (Breite_neu - Breite_alt), 0)
End If
End If
End If
End If
Next
ElseIf Abs(Winkel) = 0 Or Abs(Winkel) = 180 Then
For X = LBound(Vert) To UBound(Vert)
' Ausrichtung 1 = rechtsbündig Obere Kante des Balkens bleibt bestehen
If Ausrichtung = 1 Then
If Vert(X).Y < Balken.Centroid.Y Then
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), (Breite_neu - Breite_alt), 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), 2 * (Breite_neu - Breite_alt), 0)
End If
End If
End If
' Ausrichtung 2 = linksbündig Untere Kante des Balkens bleibt bestehen
ElseIf Ausrichtung = 2 Then
If Vert(X).Y > Balken.Centroid.Y Then
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), (Breite_neu - Breite_alt), 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), 2 * (Breite_neu - Breite_alt), 0)
End If
End If
End If
' Ausrichtung 3 = Balken wird in beide Richtungen verändert
ElseIf Ausrichtung = 3 Then
If Vert(X).Y > Balken.Centroid.Y Then
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), (Breite_neu - Breite_alt) / 2, 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel - 90), (Breite_neu - Breite_alt), 0)
End If
End If
Else
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), (Breite_neu - Breite_alt) / 2, 0)
If bGeprüft = False Then
bGeprüft = True
If Deckenbalken_Querschnittsänderung_korrekt(Vert, Balken, Breite_neu, Breite_alt) = False Then
Winkel = Winkel + 180
Vert(X) = Point3dAddAngleDistance(Vert(X), Radians(Winkel + 90), (Breite_neu - Breite_alt), 0)
End If
End If
End If
End If
Next
End If
' Eckpunkte werden verändert
For X = 1 To Balken.VerticesCount - 1
Balken.ModifyVertex X, Vert(X - 1)
Next
' Änderung wird gespeichert
Balken.Rewrite
' Wenn die neue Breite größer ist als die alte, dann werden alle Balken, welche sich mit dem breiteren Balken jetzt verschneiden, angepasst
If Breite_neu > Breite_alt Then
cScanCriteria.Reset
cScanCriteria.ExcludeAllTypes
cScanCriteria.ExcludeAllLevels
cScanCriteria.IncludeType msdElementTypeShape
cScanCriteria.IncludeLevel ActiveDesignFile.Levels.Find("DECKENBALKEN")
cScanCriteria.IncludeOnlyWithinRange Balken.Range
Set cElementEnumerator = ActiveModelReference.Scan(cScanCriteria)
Do While cElementEnumerator.MoveNext
' Initialisierung Lösch-Indikator
bLöschen = False
' Wenn sich die ID von jener des veränderten Balkens unterscheidet, dann wird geprüft, ob es Verschneidungsflächen gibt
If DLongToLong(Balken.ID) <> DLongToLong(cElementEnumerator.Current.ID) Then
On Error Resume Next
Set cIntersectEnumerator = Balken.GetIntersectionShapes(cElementEnumerator.Current)
On Error GoTo 0
If Not cIntersectEnumerator Is Nothing Then
' Wenn es Verschneidungsflächen gibt, dann werden die Differenzflächen gebildet
If UBound(cIntersectEnumerator.BuildArrayFromContents) > -1 Then
Set cDiffEnumerator = cElementEnumerator.Current.AsShapeElement.GetDifferenceShapes(Balken)
Do While cDiffEnumerator.MoveNext
' Aus den Differenzflächen wird ein neuer Balken gebildet
If cDiffEnumerator.Current.IsShapeElement Then
Set Balken_neu = cDiffEnumerator.Current.AsShapeElement
ElseIf cDiffEnumerator.Current.IsComplexShapeElement Then
Set Balken_neu = CreateShapeElement1(Balken, cDiffEnumerator.Current.AsComplexShapeElement.ConstructVertexList(0), msdFillModeNotFilled)
End If
' Es wird geprüft ob der Mittelpunkt des neuen Balkens außerhalb des veränderten Balkens liegt. Wenn ja, dann wird er platziert,
' die Sachdaten werden übernommen und der Lösch-Indikator wird auf "True" gesetzt
If Point3dInPolygonXY(Balken_neu.Centroid, Balken.GetVertices) = -1 Then
ActiveModelReference.AddElement Balken_neu
Sachdaten_übernehmen cElementEnumerator.Current, Balken_neu
bLöschen = True
End If
Loop
' Wenn der Lösch-Indikator "True" ist, dann wird der Balken gelöscht
If bLöschen = True Then
ActiveModelReference.RemoveElement cElementEnumerator.Current
End If
End If
End If
End If
Loop
End If
End Sub
Function Deckenbalken_Querschnittsänderung_korrekt(Vert() As Point3d, Balken As ShapeElement, Breite_neu As Double, Breite_alt As Double) As Boolean
Dim TempShape As ShapeElement
Dim TempPt() As Point3d
TempPt = Balken.GetVertices
' Initialisierung Rückgabewert
Deckenbalken_Querschnittsänderung_korrekt = True
' Temporär-Polygon wird erstellt
Set TempShape = CreateShapeElement1(Nothing, Vert, msdFillModeNotFilled)
' Wenn die neue Breite größer als die alte ist ...
If Breite_neu > Breite_alt Then
' und die Fläche des alten Balkens größer als jene des Temporär-Polygons, dann ist die Änderung nicht korrekt
If Balken.Area >= TempShape.Area Then
Deckenbalken_Querschnittsänderung_korrekt = False
End If
' Wenn die alte Breite größer als die neue ist ...
ElseIf Breite_alt > Breite_neu Then
' und die Fläche des alten Balkens kleiner als jene des Temporär-Polygons, dann ist die Änderung nicht korrekt
If Balken.Area <= TempShape.Area Then
Deckenbalken_Querschnittsänderung_korrekt = False
End If
End If
End FunctionThe most strange thing is that the tag element "jumps" before the code is executed! I have set a break point at the line "Private Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal oView As View)" and ran the code. The tag element was already moved when the break point was reached!
Has anyone an idea why the tag element behaves like that?