Sub InsertBlock()
Dim blockRef As AcadBlockReference
Dim blockname As String
Dim dxf_name As String
Dim props As Variant
Dim Index As Variant
Dim prop As Variant
Dim Path As String
Dim CellValue As String
Dim FinalFileName As String
Dim basePnt(0 To 2) As Double
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim objCollection As Object, docpath, dxfname
Dim ent As AcadEntity, ent2 As AcadEntity
Dim sp As New AcadSecurityParams
Dim AP As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
'в случае ошибки переходим к следующему действию
On Error Resume Next
'Подключаемся к Excel
Set AP = Excel.Application
Set WB = AP.Workbooks.Open("d:\Spec.xlsx")
Set WS = WB.Worksheets("Лист1")
'вставка блока
blockname = "ФК"
x = 0: y = 0: z = 0
basePnt(0) = x: basePnt(1) = y: basePnt(2) = z
'вставка блока
Set blockRef = ThisDrawing.ModelSpace.InsertBlock(basePnt, blockname, 1, 1, 1, 0)
'получение динамических свойств блока
If blockRef.IsDynamicBlock = True Then
props = blockRef.GetDynamicBlockProperties
For Index = LBound(props) To UBound(props)
Set prop = props(Index)
If prop.PropertyName = "Высота" Then
prop.Value = Cells(4, 2) * 1
ElseIf prop.PropertyName = "Длина" Then
prop.Value = Cells(4, 3) * 1
End If
Next
End If
Path = "d:\"
CellValue = Cells(4, 1)
FinalFileName = Path & CellValue
ThisDrawing.SaveAs FinalFileName, ac2007_dxf
End Sub