获取字典/XRecord父项

Function get_the_dict(strXRecName As String) As AcadDictionary
Dim oEnt As AcadEntity
Dim oDict As AcadDictionary
Dim oXrec As AcadXRecord
Dim oTmp2 As AcadObject
For Each oEnt In ThisDrawing.ModelSpace
    If oEnt.HasExtensionDictionary = True Then
        Set oDict = oEnt.GetExtensionDictionary
        For Each oTmp2 In oDict
            If TypeOf oTmp2 Is AcadXRecord Then
                Set oXrec = oTmp2
                If oXrec.Name = strXRecName Then
                    Set get_the_dict = oDict
                    Exit Function
                End If
            End If
        Next
    End If
Next
End Function
Sub test()
Dim oDict As AcadDictionary
Set oDict = get_the_dict("MV_PRODUCTS")
If Not oDict Is Nothing Then
    Debug.Print oDict.Handle
    'do whatever you want with it now that you have it
End If
End Sub

Function get_the_Xrec(strXRecName As String) As AcadXRecord
Dim oEnt As AcadEntity
Dim oDict As AcadDictionary
Dim oXrec As AcadXRecord
Dim oTmp2 As AcadObject
For Each oEnt In ThisDrawing.ModelSpace
    If oEnt.HasExtensionDictionary = True Then
        Set oDict = oEnt.GetExtensionDictionary
        For Each oTmp2 In oDict
            If TypeOf oTmp2 Is AcadXRecord Then
                Set oXrec = oTmp2
                If oXrec.Name = strXRecName Then
                    Set get_the_Xrec = oXrec
                    Exit Function
                End If
            End If
        Next
    End If
Next
End Function
Sub test2()
Dim oXrec As AcadXRecord
Set oXrec = get_the_Xrec("MV_PRODUCTS")
If Not oXrec Is Nothing Then
    Debug.Print oXrec.Handle
    'do whatever you want with it now that you have it
    Dim xdata As Variant
    Dim xcode As Variant
    oXrec.GetXRecordData xcode, xdata
End If
End Sub