Sub insertedblock()
Dim blockRef As AcadBlockReference
Dim name As String
Dim Ap As Excel.Application
Dim wb As Workbook
Dim ws As Excel.Worksheet
On Error Resume Next

'подключение к Excel
Set Ap = Excel.Application
Set wb = Workbooks.Open(" ЧТО ТУТ писать ")
Set ws = wb.Workbooks("Лист4")

'получаем точку ввода блока
pp = ThisDrawing.Utiliti.GetPoint(, "Укажите точку вставки блока")

'вставка блока
name = "тестовый"
Set blockRef = ThisDrawing.ModelSpace.InsertBlock(pp, name, 1, 1, 1, 0)

'получение атрибутов
If blockRef.HasAttributea = True Then
att = blockRef.GetAttributea
For l = LBound(att) To UBound(att)
If att(l).TagString = " ? " Then
att(l).TaxString = Cells(1, 1)
End If
Next
End If

If blockRef.HasAttributea = True Then
att = blockRef.GetAttributea
For l = LBound(att) To UBound(att)
If att(l).TagString = "н -----1" Then
att(l).TaxString = Cells(1, 2)
End If
Next
End If

If blockRef.HasAttributea = True Then
att = blockRef.GetAttributea
For l = LBound(att) To UBound(att)
If att(l).TagString = "P___" Then
att(l).TaxString = Cells(1, 3)
End If
Next
End If

If blockRef.HasAttributea = True Then
att = blockRef.GetAttributea
For l = LBound(att) To UBound(att)
If att(l).TagString = "Тok___" Then
att(l).TaxString = Cells(1, 5)
End If
Next
End If

If blockRef.HasAttributea = True Then
att = blockRef.GetAttributea
For l = LBound(att) To UBound(att)
If att(l).TagString = "Напряжение__а1" Then
att(l).TaxString = Cells(1, 6)
End If
Next
End If

If blockRef.HasAttributea = True Then
att = blockRef.GetAttributea
For l = LBound(att) To UBound(att)
If att(l).TagString = "расположение1" Then
att(l).TaxString = Cells(1, 7)
End If
Next
End If

'выходим из Excel
Ap.Quit
End Sub