Sub InsertBlockRazrez_1()
Dim blockRef As AcadBlockReference
Dim name As String
Dim pp As Variant
Dim AP As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim insPnt(0 To 2) As Double
'В случае ошибки переходим к следующему действию
On Error Resume Next
'Подключаемся к Excel
Set AP = Excel.Application
Set WB = AP.Workbooks.Open("C:\Probnic\primer.xlsm")
Set WS = WB.Worksheets("Лист1")
'Получаем точку вставки блока
pp = ThisDrawing.Utility.GetPoint(, "Укажите точку вставки блока:")
'Считываем данные с Excel имя блока
name_b = Cells(21, 1)
' Имя блока
name = name_b
' Вставка блока
Set blockRef = ThisDrawing.ModelSpace.InsertBlock(pp, name, 1, 1, 1, 0)
'Получение динамических свойств блока
If blockRef.IsDynamicBlock = True Then
Props = blockRef.GetDynamicBlockProperties
For Index = LBound(Props) To UBound(Props)
Set prop = Props(Index)
'Получение динамических свойств блока Расстояние1
If prop.PropertyName = "Расстояние1" Then
prop.Value = Cells(17, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние1
'Получение динамических свойств блока Расстояние2
ElseIf prop.PropertyName = "Расстояние2" Then
prop.Value = Cells(18, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние2
'Получение динамических свойств блока Расстояние3
ElseIf prop.PropertyName = "Расстояние3" Then
prop.Value = Cells(19, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние3
'Получение динамических свойств блока Расстояние4
ElseIf prop.PropertyName = "Расстояние4" Then
prop.Value = Cells(20, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние4
'Получение динамических свойств блока Расстояние5
ElseIf prop.PropertyName = "Расстояние5" Then
prop.Value = Cells(21, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние5
'Получение динамических свойств блока Расстояние6
ElseIf prop.PropertyName = "Расстояние6" Then
prop.Value = Cells(22, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние6
'Получение динамических свойств блока Расстояние7
ElseIf prop.PropertyName = "Расстояние7" Then
prop.Value = Cells(23, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние7
'Получение динамических свойств блока Расстояние8
ElseIf prop.PropertyName = "Расстояние8" Then
prop.Value = Cells(24, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние8
'Получение динамических свойств блока Расстояние9
ElseIf prop.PropertyName = "Расстояние9" Then
prop.Value = Cells(25, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние9
'Получение динамических свойств блока Расстояние10
ElseIf prop.PropertyName = "Расстояние10" Then
prop.Value = Cells(26, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние10
'Получение динамических свойств блока Расстояние11
ElseIf prop.PropertyName = "Расстояние11" Then
prop.Value = Cells(27, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние11
'Получение динамических свойств блока Расстояние12
ElseIf prop.PropertyName = "Расстояние12" Then
prop.Value = Cells(28, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние12
'Получение динамических свойств блока Расстояние13
ElseIf prop.PropertyName = "Расстояние13" Then
prop.Value = Cells(29, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние13
'Получение динамических свойств блока Расстояние14
ElseIf prop.PropertyName = "Расстояние14" Then
prop.Value = Cells(30, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние14
End If
Next
End If
'Получение атрибутов
If blockRef.HasAttributes = True Then
att = blockRef.GetAttributes
For i = LBound(att) To UBound(att)
'Получение атрибутов TIP_GRUNDA_1
If att(i).TagString = "TIP_GRUNDA_1" Then
att(i).TextString = Cells(17, 8) 'Считываем данные с Excel TIP_GRUNDA_1
'Получение атрибутов TIP_GRUNDA_2
ElseIf att(i).TagString = "TIP_GRUNDA_2" Then
att(i).TextString = Cells(18, 8) 'Считываем данные с Excel TIP_GRUNDA_2
'Получение атрибутов TIP_GRUNDA_3
ElseIf att(i).TagString = "TIP_GRUNDA_3" Then
att(i).TextString = Cells(19, 8) 'Считываем данные с Excel TIP_GRUNDA_3
'Получение атрибутов TIP_GRUNDA_4
ElseIf att(i).TagString = "TIP_GRUNDA_4" Then
att(i).TextString = Cells(20, 8) 'Считываем данные с Excel TIP_GRUNDA_4
'Получение атрибутов UROVEN_JISTOGO_POLA
ElseIf att(i).TagString = "UROVEN_JISTOGO_POLA" Then
att(i).TextString = Cells(21, 8) 'Считываем данные с Excel UROVEN_JISTOGO_POLA
'Получение атрибутов UROVEN_ZEMLI
ElseIf att(i).TagString = "UROVEN_ZEMLI" Then
att(i).TextString = Cells(22, 8) 'Считываем данные с Excel UROVEN_ZEMLI
'Получение атрибутов UROVEN_POD_VOD
ElseIf att(i).TagString = "UROVEN_POD_VOD" Then
att(i).TextString = Cells(23, 8) 'Считываем данные с Excel UROVEN_POD_VOD
'Получение атрибутов OTM_FUN_V2
ElseIf att(i).TagString = "OTM_FUN_V2" Then
att(i).TextString = Cells(24, 8) 'Считываем данные с Excel OTM_FUN_V2
'Получение атрибутов OTM_PODUHCI
ElseIf att(i).TagString = "OTM_PODUHCI" Then
att(i).TextString = Cells(25, 8) 'Считываем данные с Excel OTM_PODUHCI
'Получение атрибутов OTM_SL_1
ElseIf att(i).TagString = "OTM_SL_1" Then
att(i).TextString = Cells(26, 8) 'Считываем данные с Excel OTM_SL_1
'Получение атрибутов OTM_SL_2
ElseIf att(i).TagString = "OTM_SL_2" Then
att(i).TextString = Cells(27, 8) 'Считываем данные с Excel OTM_SL_2
'Получение атрибутов OTM_SL_3
ElseIf att(i).TagString = "OTM_SL_3" Then
att(i).TextString = Cells(28, 8) 'Считываем данные с Excel OTM_SL_3
'Получение атрибутов OTM_CKV_1
ElseIf att(i).TagString = "OTM_CKV_1" Then
att(i).TextString = Cells(29, 8) 'Считываем данные с Excel OTM_CKV_1
'Получение атрибутов OTM_CKV_2
ElseIf att(i).TagString = "OTM_CKV_2" Then
att(i).TextString = Cells(30, 8) 'Считываем данные с Excel OTM_CKV_2
'Получение атрибутов OTM1-1.1
ElseIf att(i).TagString = "OTM1-1.1" Then
att(i).TextString = Cells(17, 14) 'Считываем данные с Excel OTM1-1.1
'Получение атрибутов OTM1-1.1_2
ElseIf att(i).TagString = "OTM1-1.1_2" Then
att(i).TextString = Cells(18, 14) 'Считываем данные с Excel OTM1-1.1_2
'Получение атрибутов OTM1-1.2
ElseIf att(i).TagString = "OTM1-1.2" Then
att(i).TextString = Cells(19, 14) 'Считываем данные с Excel OTM1-1.2
'Получение атрибутов OTM1-1.2_3
ElseIf att(i).TagString = "OTM1-1.2_3" Then
att(i).TextString = Cells(20, 14) 'Считываем данные с Excel OTM1-1.2_3
'Получение атрибутов OTM1-1.3
ElseIf att(i).TagString = "OTM1-1.3" Then
att(i).TextString = Cells(21, 14) 'Считываем данные с Excel OTM1-1.3
'Получение атрибутов OTM1-1.3_4
ElseIf att(i).TagString = "OTM1-1.3_4" Then
att(i).TextString = Cells(22, 14) 'Считываем данные с Excel OTM1-1.3_4
'Получение атрибутов OTM1-1.4
ElseIf att(i).TagString = "OTM1-1.4" Then
att(i).TextString = Cells(23, 14) 'Считываем данные с Excel OTM1-1.4
'Получение атрибутов OTM1-1.4_5
ElseIf att(i).TagString = "OTM1-1.4_5" Then
att(i).TextString = Cells(24, 14) 'Считываем данные с Excel OTM1-1.4_5
'Получение атрибутов OTM1-1.5
ElseIf att(i).TagString = "OTM1-1.5" Then
att(i).TextString = Cells(25, 14) 'Считываем данные с Excel OTM1-1.5
'Получение атрибутов OTM1-1.5_6
ElseIf att(i).TagString = "OTM1-1.5_6" Then
att(i).TextString = Cells(26, 14) 'Считываем данные с Excel OTM1-1.5_6
'Получение атрибутов OTM1-1.6
ElseIf att(i).TagString = "OTM1-1.6" Then
att(i).TextString = Cells(27, 14) 'Считываем данные с Excel OTM1-1.6
'Получение атрибутов OTM1-1.6_7
ElseIf att(i).TagString = "OTM1-1.6_7" Then
att(i).TextString = Cells(28, 14) 'Считываем данные с Excel OTM1-1.6_7
'Получение атрибутов OTM1-1.7
ElseIf att(i).TagString = "OTM1-1.7" Then
att(i).TextString = Cells(29, 14) 'Считываем данные с Excel OTM1-1.7
'Получение атрибутов OTM1-1.7_8
ElseIf att(i).TagString = "OTM1-1.7_8" Then
att(i).TextString = Cells(30, 14) 'Считываем данные с Excel OTM1-1.7_8
'Получение атрибутов OTM1-1.8
ElseIf att(i).TagString = "OTM1-1.8" Then
att(i).TextString = Cells(31, 14) 'Считываем данные с Excel OTM1-1.8
'Получение атрибутов OTM1-1.8_9
ElseIf att(i).TagString = "OTM1-1.8_9" Then
att(i).TextString = Cells(17, 17) 'Считываем данные с Excel OTM1-1.8_9
'Получение атрибутов OTM1-1.9
ElseIf att(i).TagString = "OTM1-1.9" Then
att(i).TextString = Cells(18, 17) 'Считываем данные с Excel OTM1-1.9
'Получение атрибутов OTM1-1.9_10
ElseIf att(i).TagString = "OTM1-1.9_10" Then
att(i).TextString = Cells(19, 17) 'Считываем данные с Excel OTM1-1.9_10
'Получение атрибутов OTM1-1.10
ElseIf att(i).TagString = "OTM1-1.10" Then
att(i).TextString = Cells(20, 17) 'Считываем данные с Excel OTM1-1.10
'Получение атрибутов OTM1-1.10_11
ElseIf att(i).TagString = "OTM1-1.10_11" Then
att(i).TextString = Cells(21, 17) 'Считываем данные с Excel OTM1-1.10_11
'Получение атрибутов OTM1-1.11
ElseIf att(i).TagString = "OTM1-1.11" Then
att(i).TextString = Cells(22, 17) 'Считываем данные с Excel OTM1-1.11
'Получение атрибутов OTM1-1.11_12
ElseIf att(i).TagString = "OTM1-1.11_12" Then
att(i).TextString = Cells(23, 17) 'Считываем данные с Excel OTM1-1.11_12
'Получение атрибутов OTM1-1.12
ElseIf att(i).TagString = "OTM1-1.12" Then
att(i).TextString = Cells(24, 17) 'Считываем данные с Excel OTM1-1.12
'Получение атрибутов OTM1-1.12_13
ElseIf att(i).TagString = "OTM1-1.12_13" Then
att(i).TextString = Cells(25, 17) 'Считываем данные с Excel OTM1-1.12_13
'Получение атрибутов OTM1-1.13
ElseIf att(i).TagString = "OTM1-1.13" Then
att(i).TextString = Cells(26, 17) 'Считываем данные с Excel OTM1-1.13
'Получение атрибутов OTM1-1.13_14
ElseIf att(i).TagString = "OTM1-1.13_14" Then
att(i).TextString = Cells(27, 17) 'Считываем данные с Excel OTM1-1.13_14
'Получение атрибутов OTM1-1.14
ElseIf att(i).TagString = "OTM1-1.14" Then
att(i).TextString = Cells(28, 17) 'Считываем данные с Excel OTM1-1.14
'Получение атрибутов OTM1-1.14_15
ElseIf att(i).TagString = "OTM1-1.14_15" Then
att(i).TextString = Cells(29, 17) 'Считываем данные с Excel OTM1-1.14_15
'Получение атрибутов OTM1-1.15
ElseIf att(i).TagString = "OTM1-1.15" Then
att(i).TextString = Cells(30, 17) 'Считываем данные с Excel OTM1-1.15
End If
Next
End If
'Закрываем Excel
AP.Quit
End Sub