This AutoCAD VBA code will not compile - passing a TYPE as a VARIANT

Question

I have the following VBA code which it being compiled and executed inside AutoCAD 2014 (64 bit):

Option Explicit

Type HatchData
    iTag As Integer
    iType As Integer
    strPattern As String
    dScale As Double
    strLayer As String
End Type

Public Sub UpdateHatches()
    Dim mapHatches As Collection

    Call ReadHatchINI(mapHatches)

    MsgBox "Finished"
End Sub

Private Function ReadHatchINI(ByRef mapHatches As Collection)
    Dim vPath          As Variant

    vPath = m_cREG.QueryValue("Software\PathXXX", "HatchesPathINI")
    With m_cINI
        .path = vPath
        .Section = "Hatches"
        .Key = "NumHatches"
        .Default = 0

        Dim iHatch As Integer, iNumHatches As Integer
        Dim strHatchData As String
        Dim aryStrTokens() As String
        iNumHatches = .Value

        .Default = ""
        For iHatch = 1 To iNumHatches
            .Key = "Hatch" & CStr(iHatch)

            strHatchData = .Value
            If (strHatchData <> "") Then
                aryStrTokens = Split(strHatchData, " ", , vbTextCompare)

                ' TODO: Is it OK to declare the variable here ?
                Dim oHatchData As HatchData
                oHatchData.iTag = aryStrTokens(0)
                oHatchData.iType = aryStrTokens(1)
                oHatchData.strPattern = aryStrTokens(2)
                oHatchData.dScale = aryStrTokens(3)
                oHatchData.strLayer = aryStrTokens(4)

                ' TODO: Can't pass this HatchData object
                Call cSet(mapHatches, CStr(oHatchData.iTag), oHatchData)
            End If
        Next
    End With
End Function

Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
    If (cHas(Col, Key)) Then Col.Remove Key
    Col.Add Array(Key, Item), Key
End Sub

Private Function cGet(ByRef Col As Collection, Key As String) As Variant
    If Not cHas(Col, Key) Then Exit Function
    On Error Resume Next
        Err.Clear
        Set cGet = Col(Key)(1)
        If Err.Number = 13 Then
            Err.Clear
            cGet = Col(Key)(1)
        End If
    On Error GoTo 0
    If Err.Number <> 0 Then Call Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function

Public Function cHas(Col As Collection, Key As String) As Boolean
    cHas = True
    On Error Resume Next
        Err.Clear
        Col (Key)
        If Err.Number <> 0 Then
            cHas = False
            Err.Clear
        End If
    On Error GoTo 0
End Function

Private Sub cRemove(ByRef Col As Collection, Key As String)
    If cHas(Col, Key) Then Col.Remove Key
End Sub

Private Function cKeys(ByRef Col As Collection) As String()
    Dim Initialized As Boolean
    Dim Keys() As String

    For Each Item In Col
        If Not Initialized Then
            ReDim Preserve Keys(0)
            Keys(UBound(Keys)) = Item(0)
            Initialized = True
        Else
            ReDim Preserve Keys(UBound(Keys) + 1)
            Keys(UBound(Keys)) = Item(0)
        End If
    Next Item

    cKeys = Keys
End Function

I have a specific issue related to this code:

' TODO: Can't pass this HatchData object
Call cSet(mapHatches, CStr(oHatchData.iTag), oHatchData)

This is the VBA error message that displays when I try to run it:

How can I change the code so that I can populate my collection?

Thank you !

Andrew

score 0 · Accepted Answer · edited May 23 '17 at 11:53

Having come across this related question:

User Defined Type (UDT) as parameter in public Sub in class module (VB6)

I decided to change my logic. Now I have a simple list of HatchData objects and the Collection is just a mapping from the tag to the index in the list.

This compiles and runs fine. So when I get the index from the map I can quickly get the HatchData from my list using that lookup map index.

Option Explicit

Type HatchData
    iTag As Integer
    iType As Integer
    strPattern As String
    dScale As Double
    strLayer As String
End Type

Public Sub UpdateHatches()
    Dim aryHatches() As HatchData
    Dim mapHatches As Collection

    Set mapHatches = New Collection

    Call ReadHatchINI(aryHatches, mapHatches)

    MsgBox "Finished"
End Sub

Private Function ReadHatchINI(ByRef aryHatches() As HatchData, ByRef mapHatches As Collection)
    Dim vPath As Variant

    vPath = m_cREG.QueryValue("Software\PathXXXXX", "HatchesPathINI")
    With m_cINI
        .path = vPath
        .Section = "Hatches"
        .Key = "NumHatches"
        .Default = 0

        Erase aryHatches

        Dim iHatch As Integer, iNumHatches As Integer
        Dim strHatchData As String
        Dim aryStrTokens() As String
        iNumHatches = .Value

        .Default = ""
        For iHatch = 0 To iNumHatches - 1
            .Key = "Hatch" & CStr(iHatch + 1)

            strHatchData = .Value
            If (strHatchData <> "") Then
                aryStrTokens = Split(strHatchData, " ", , vbTextCompare)

                ReDim Preserve aryHatches(0 To iHatch)

                With aryHatches(iHatch)
                    .iTag = aryStrTokens(0)
                    .iType = aryStrTokens(1)
                    .strPattern = aryStrTokens(2)
                    .dScale = aryStrTokens(3)
                    .strLayer = aryStrTokens(4)
                End With

                ' TODO: Can't pass this HatchData object
                Call cSet(mapHatches, CStr(aryHatches(iHatch).iTag), iHatch)
            End If
        Next
    End With
    ' By the end we have a list of HatchData objects
    ' and a lookup map of tag id to HatchData index positions
End Function

Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
    If (cHas(Col, Key)) Then Col.Remove Key
    Call Col.Add(Item, Key)
End Sub

Private Function cGet(ByRef Col As Collection, Key As String) As Variant
    If Not cHas(Col, Key) Then Exit Function
    On Error Resume Next
        Err.Clear
        Set cGet = Col(Key)(1)
        If Err.Number = 13 Then
            Err.Clear
            cGet = Col(Key)(1)
        End If
    On Error GoTo 0
    If Err.Number <> 0 Then Call Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function

Public Function cHas(Col As Collection, Key As String) As Boolean
    cHas = True
    On Error Resume Next
        Err.Clear
        Col (Key)
        If Err.Number <> 0 Then
            cHas = False
            Err.Clear
        End If
    On Error GoTo 0
End Function

Private Sub cRemove(ByRef Col As Collection, Key As String)
    If cHas(Col, Key) Then Col.Remove Key
End Sub

This AutoCAD VBA code will not compile - passing a TYPE as a VARIANT

1 Answers1