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.