' Получаем коллекцию динамических свойств
     Set objBlockRef = acadDoc.ModelSpace.InsertBlock(pntPanel, Name, 1, 1, 1, 0)
     BlkAtts = objBlockRef.GetDynamicBlockProperties
       
       
     BlkAtts = objBlockRef.GetAttributes
     acadDoc.Regen acAllViewports
    acadApp.ZoomExtents


dynProps = objBlockRef.GetDynamicBlockProperties

' Перебираем свойства
For j = LBound(dynProps) To UBound(dynProps)
    'i = 0
    Set prop = dynProps(j)
    Debug.Print j
    Debug.Print "Свойство: " & prop.PropertyName
    If prop.PropertyName <> "Origin" Then Debug.Print "Значение: " & prop.Value
'Для ввода
If prop.PropertyName = "Видимость1" Then
         str = sh.Cells(nrs, 12).text
        dynProps(j).Value = str
         BlkAtts = objBlockRef.GetAttributes
         acadDoc.Regen acAllViewports
    End If
 'Для отходящей группы
    If prop.PropertyName = "Видимость 1" Then
         str = sh.Cells(nrs, 12).text
        dynProps(j).Value = str
         BlkAtts = objBlockRef.GetAttributes
         acadDoc.Regen acAllViewports
    End If
    
     'Для отходящей группы
    If prop.PropertyName = "Вид" Then
         str = sh.Cells(nrs, 13).text
        dynProps(j).Value = str
         BlkAtts = objBlockRef.GetAttributes
         acadDoc.Regen acAllViewports
    End If

               'Получаем атрибуты для блочной ссылки
    str = ""
    varAttributes = objBlockRef.GetAttributes
     If Name = "Шины" Or Name = "Оконечные устройства" Then Exit Sub
       For i = LBound(varAttributes) To UBound(varAttributes)
       
       Debug.Print varAttributes(i).TagString
       Debug.Print varAttributes(i).TextString
 
    If varAttributes(i).TagString = "МАРКА_КАБЕЛЯ" Then
     str = sh.Cells(nrs, 6).text
     varAttributes(i).TextString = str
    
         BlkAtts = objBlockRef.GetAttributes
         acadDoc.Regen acAllViewports

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If Not Intersect(Target, Range("F1")) Is Nothing Then
            Target = Range("F1").MergeArea.Cells(1).Value
            If Range("F1").MergeArea.Cells(1).Value = "Петя" Then
                Range("F1").MergeArea.Cells(1).Value = "Вася"
            Else
                Range("F1").MergeArea.Cells(1).Value = "Петя"
            End If
        Cancel = True
    End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("F1")) Is Nothing Then
            'Target.Font.Name = "Wingdings 2"
            If Target = "Вася" Then
                Target = "Петя"
            Else
                Target = "Вася"
            End If
        Cancel = True
           'Call InMidStr1
    End If
End Sub