Sub BlockIntoAcadtable2()
Dim ssName As String
Dim ssetobj As AcadSelectionSet
Dim blk2 As AcadBlockReference
Dim name1 As String
Dim block As AcadBlock
Dim t1 As String
Dim n1 As String
Dim ID As LONG_PTR
Dim Attributes As Variant
Dim table As AcadTable
On Error Resume Next
name1 = "111"
Set block = ThisDrawing.Blocks.Item(name1)
ID = block.ObjectID
ThisDrawing.SelectionSets.Item(ssName).Delete
Set ssetobj = ThisDrawing.SelectionSets.Add(ssName)
Dim gpCode(0 To 1) As Integer
Dim dataValue(0 To 1) As Variant
gpCode(0) = 0: dataValue(0) = "INSERT"
gpCode(1) = 2: dataValue(1) = "111"
ssetobj.Select acSelectionSetAll, , , gpCode, dataValue
For Each blk2 In ssetobj
Attributes = blk2.GetAttributes
t1 = Attributes(0).TextString
Next
ThisDrawing.SelectionSets("ss").Delete
Set ss = ThisDrawing.SelectionSets.Add("ss")
ss.SelectOnScreen
For Each table In ss
n1 = table.GetCellValue(7, 0)
If n1 = t1 Then
table.SetBlockTableRecordId 7, 5, ID, True
End If
Next
End Sub