Sub PlotByBlocks()
'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
'
'
Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument
'Получаем ссылку на приложение автокада
Set acadApp = GetObject(, "AutoCad.Application")
Set acadDoc = acadApp.ActiveDocument
If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
acadDoc.ActiveSpace = 1 '1 = acModelSpace in early binding
End If
Dim objEnt As AcadObject
Dim objBRef As AcadBlockReference
Dim pt1 As Variant
Dim pt2(0 To 1) As Double
Dim i As Integer
Dim ss As AcadSelectionSet
'Проверить существует ли набор с таким именем
Set ss = acadDoc.SelectionSets.Item("SS")
'если не существует то создаем
If ss Is Nothing Then
Set ss = acadDoc.SelectionSets.Add("SS")
End If
ss.SelectonScreen
On Error Resume Next
i = 0
For Each objEnt In ss
'У вас было не правильное имя
If objEnt.ObjectName = "AcDbBlockReference" Then
Set objBRef = objEnt
If objBRef.EffectiveName = "А1ашб" Then
pt1 = objBRef.InsertionPoint
pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
ReDim Preserve pt1(0 To 1)
pt2(0) = pt1(0) + 84100
pt2(1) = pt1(1) + 59400
i = i + 1
'так как код запускается из Екселя, мы не можем ссылаться на ThisDrawling, нужно в процедуру PolyPlot передать ссылку на документ автокада
'ActiveWorkbook.Path -- путь вашего екселя
PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(i), pt1, pt2 ' желательно по пути файла Excel сохранить в папку из ячейки B1
End If
End If
Next
End Sub
Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant)
Dim Layout As AcadLayout
'замена ThisDrawling на ссылку чертежа в автокад
Set Layout = acadDoc.ActiveLayout
Layout.RefreshPlotDeviceInfo
Layout.ConfigName = "DWG To PDF.pc3"
'в видео Максим Маркевич акцентировал что имя формата должно быть на английском с заменой пробелов на нижнее подчеркивание
Layout.CanonicalMediaName = "ISO_full_bleed_A1_(841.00_x_594.00_MM)"
Layout.CenterPlot = True
Layout.PlotRotation = ac0degrees
Layout.StandardScale = acScaleToFit
Layout.StyleSheet = "acad.ctb"
Layout.SetWindowToPlot pt1, pt2
Layout.PlotType = acWindow
'замена ThisDrawling на ссылку чертежа в автокад
acadDoc.Regen acAllViewports
acadDoc.Plot.PlotToFile strFileName
End Sub
