Quantcast
Channel: MicroStation Programming Forum - Recent Threads
Viewing all articles
Browse latest Browse all 7260

[V8i VBA] 2 odd issues: Userform_Initialize event being triggered / Class loop not completing

$
0
0

Nearing the end of a long VBA project; I'm finally back working in my text creation class but I have 2 odd issues which I would like to solve, both of which are within are encountered when the class is used.

Problem 1

I have the following function in my class:

Private Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal View As View)

Dim oText_Chaingage                               As TextElement
Dim oText_LB1                                     As TextElement
Dim oText_LB2                                     As TextElement
Dim oText_LB3                                     As TextElement
Dim i                                             As Long

CommandState.AccuDrawHints.SetOrigin Point

If m_nWorksheets = 1 Then
    Set oText_Chaingage = WriteChainage(Point, ArrayChainage, "0,0,255")
    Set oText_LB1 = TextFromArray(Point, ArraysSorted(i), "255,0,0", FrmMain.LB_Sheet1)

ElseIf m_nWorksheets = 3 Then
    Set oText_Chaingage = WriteChainage(Point, ArrayChainage, "0,0,255")
    For i = LBound(ArraysSorted, 1) To UBound(ArraysSorted, 1)
        Select Case i
            Case 0
                Set oText_LB1 = TextFromArray(Point, ArraysSorted(0), "255,0,0", FrmMain.LB_Sheet1)
            Case 1
                Set oText_LB2 = TextFromArray(Point, ArraysSorted(1), "255,0,0", FrmMain.LB_Sheet2)
            Case 2
                Set oText_LB3 = TextFromArray(Point, ArraysSorted(2), "255,0,0", FrmMain.LB_Sheet3)
        End Select
    Next i
End If
End Sub

Debugging step by step through this, I notice once I get to Set oText_LB1 line, pressing F8 doesnt take my into the TextFromArray function but instead into the Useform_Initialize event. I know its because I am passing a fully qualified listbox (Form Control) name as a parameter to the TextFromArray function but why is it triggering the Userform_Initialize event??

Problem 2

Below is my TextFromArray function mentioned in problem (its due to be made more efficient once I have it fully working):

Private Function TextFromArray(Point As Point3d, ByRef CurrArray As Variant, ByVal sRGBVal As String, Optional ByVal LBox As ListBox)

Dim R                                             As Long
Dim C                                             As Long
Dim oFont                                         As Font
Dim oText                                         As TextElement
Dim DataPoint                                     As Point3d
Dim ItemOffset                                    As Point3d
Dim Header                                        As Point3d
Dim FirstItem                                     As Point3d
Dim sRGBVals()                                    As String

sRGBVals() = Split(sRGBVal, ",", , vbTextCompare)

For C = LBound(CurrArray, 2) To UBound(CurrArray, 2)
    For R = LBound(CurrArray, 1) To UBound(CurrArray, 1)
        Select Case R
            Case 0
                If CStr(CurrArray(R, C)) = vbNullString Then
                    Set oText = CreateTextElement1(Nothing, "0", Point, Matrix3dIdentity)
                Else
                    Set oText = CreateTextElement1(Nothing, CStr(CurrArray(R, C)), Point, Matrix3dIdentity)
                End If
                Set TextFromArray = oText
                Set oFont = ActiveDesignFile.Fonts.Find(msdFontTypeWindowsTrueType, M_TextFont)
                oText.TextStyle.Font = oFont
                oText.TextStyle.Height = 0.36
                oText.TextStyle.Width = 0.36
                oText.TextStyle.Color = ActiveModelReference.InternalColorFromRGBColor(RGB(sRGBVals(0), sRGBVals(1), sRGBVals(2)))
                oText.TextStyle.Justification = msdTextJustificationRightCenter
                oText.Redraw msdDrawingModeNormal
                ActiveModelReference.AddElement oText

                FirstItem = Point3dAdd(Point, Point3dFromXYZ(3.5, 0, 0))
                Point = FirstItem

            Case Else
                If CStr(CurrArray(R, C)) = vbNullString Then
                    Set oText = CreateTextElement1(Nothing, "0", Point, Matrix3dIdentity)
                Else
                    Set oText = CreateTextElement1(Nothing, CStr(CurrArray(R, C)), Point, Matrix3dIdentity)
                End If
                Set TextFromArray = oText
                Set oFont = ActiveDesignFile.Fonts.Find(msdFontTypeWindowsTrueType, M_TextFont)
                oText.TextStyle.Font = oFont
                oText.TextStyle.Height = 0.5
                oText.TextStyle.Width = 0.5
                oText.TextStyle.Color = ActiveModelReference.InternalColorFromRGBColor(RGB(sRGBVals(0), sRGBVals(1), sRGBVals(2)))
                oText.TextStyle.Justification = msdTextJustificationCenterCenter
                oText.Redraw msdDrawingModeNormal
                ActiveModelReference.AddElement oText
                
                ItemOffset = Point3dAdd(Point, Point3dFromXYZ(5, 0, 0))
                Point = ItemOffset
        End Select
    Next R
    If InStr(1, CStr(CurrArray(0, C)), "Alignment", vbTextCompare) = 0 And InStr(1, CStr(CurrArray(0, C + 1)), "Alignment", vbTextCompare) > 0 Then
    Point = Point3dAdd(FirstItem, Point3dFromXYZ(-3.5, -3.25, 0))
    ElseIf InStr(1, CStr(CurrArray(0, C)), "Alignment", vbTextCompare) > 0 And InStr(1, CStr(CurrArray(0, C + 1)), "Alignment", vbTextCompare) > 0 Then
    Point = Point3dAdd(FirstItem, Point3dFromXYZ(-3.5, -4, 0))
    ElseIf InStr(1, CStr(CurrArray(0, C)), "Alignment", vbTextCompare) > 0 And InStr(1, CStr(CurrArray(0, C + 1)), "Alignment", vbTextCompare) = 0 Then
    Point = Point3dAdd(FirstItem, Point3dFromXYZ(-3.5, -3.25, 0))
    Else
    Point = Point3dAdd(FirstItem, Point3dFromXYZ(-3.5, -2.5, 0))
    End If
    Next C
End Function

The problem I am finding with this is that once I have reached the UBound of the Array in both directions, nothing happens, it just stops and the value of i in the select case statement within IPrimitiveCommandEvents_DataPoint doesn't get to increment. If I change the end of the function to:

Next R
    Point = Point3dAdd(FirstItem, Point3dFromXYZ(-3.5, -2.5, 0))
    Next C
End Function

It works fine however I am left with a constant size (vertically) between rows of text. The whole point of the InStr functions is to adjust the insertion point of the next row if the current rows (or the next row) header value contains the word "alignment". Question is, why does the loop stop/freeze?

The following image shows the problem. The Rows of text with a header containing the word "alignment" have been highlighted as green, each of these rows should be vertically centered in the appropriate table box highlighted cyan for clarity.


Viewing all articles
Browse latest Browse all 7260

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>