Sub AddAttrValue()
Dim xlApp As Object
Dim sht As Object
Dim i As Integer
Dim j As Integer
Dim Arr() As String
Dim endRow As Integer
Dim endCol As Integer
Dim ss_dim As AcadSelectionSet
Dim ent As AcadEntity
Dim blockRefObj As AcadBlockReference

Set xlApp = GetObject(, "Excel.Application")
Set sht = xlApp.Activesheet
endRow = sht.cells(65536, 1).End(-4162).Row

endRow = sht.cells(65536, 1).End(-4162).Row
endCol = sht.cells(1, 255).End(-4159).Column
ReDim Arr(1 To endRow, 1 To endCol)

For i = 1 To endRow
    For j = 1 To endCol
        Arr(i, j) = sht.cells(i, j)
    Next j
Next i

On Error Resume Next
ThisDrawing.SelectionSets("ssBlkRef").Delete
On Error GoTo 0
Set ss_dim = ThisDrawing.SelectionSets.Add("ssBlkRef")

Dim datavalue(0) As Variant, gpcode(0) As Integer, groupCode As Variant, dataCode As Variant

gpcode(0) = 2: datavalue(0) = "图签" '图块名称
groupCode = gpcode: dataCode = datavalue

ss_dim.SelectOnScreen groupCode, dataCode   '鼠标框选

Dim varAttributes
Dim IsFound As Boolean
Dim iArr() As String
Dim SuccessRow() As Integer
ReDim iArr(1 To endCol)
Dim k As Integer
ReDim SuccessRow(0 To 0)
For Each ent In ss_dim
    If StrComp(ent.ObjectName, "acDbBlockReference", 1) = 0 Then
        Set blockRefObj = ent
        varAttributes = blockRefObj.GetAttributes
        IsFound = False
        '查找
        For i = LBound(varAttributes) To UBound(varAttributes)
            If varAttributes(i).TagString = Arr(1, 1) Then
                For j = 1 To endRow
                    If varAttributes(i).TextString = Arr(j, 1) Then
                        IsFound = True
                        ReDim Preserve SuccessRow(0 To UBound(SuccessRow) + 1)
                        SuccessRow(UBound(SuccessRow)) = j
                        For k = 1 To endCol
                            iArr(k) = Arr(j, k)
                        Next k
                        
                    End If
                Next j
            End If
        Next
        '写入
        If IsFound Then
            For i = LBound(varAttributes) To UBound(varAttributes)
                For j = 1 To endCol
                    If varAttributes(i).TagString = Arr(1, j) Then varAttributes(i).TextString = iArr(j)
                Next
            Next i
        End If
        
    End If
Next ent

For i = 1 To UBound(SuccessRow)
    sht.cells(SuccessRow(i), 1).Interior.ColorIndex = 6
Next i

MsgBox "已根据第一列匹配，并将数据填写入DWG"


End Sub