' 3. Batch printing of specific blocks-formats
Sub PlotByBlocks()
' Dim objEnt As AcadEntity
Dim objBRef As AcadBlockReference
Dim pt1 As Variant
Dim pt2(0 To 1) As Double
Dim i As Integer
' Create a selection with a frame
On Error Resume Next
Dim ent As AcadEntity
Dim selset As AcadSelectionSet
Dim ssName As String
Dim filterData As Variant, filterType As Variant
ssName = "adncis"
On Error Resume Next
ThisDrawing.SelectionSets.Item(ssName).Delete
filterType(0) = 0
filterData(0) = "INSERT"
i = i + 1
Set selset = ThisDrawing.SelectionSets.Add(ssName)
selset.SelectOnScreen filterType, filterData
For Each ent In selset
If Left(ent.Name, 2) = "*U" Then
selset.RemoveItems ent
End If
Next
'ThisDrawing.SelectionSets("SS").Delete
'Set ss = ThisDrawing.SelectionSets.Add("SS")
'ss.SelectOnScreen
' We work if the name of the A1 block
i = 0
For Each ent In selset
If ent.ObjectName = "AcDbBlockReference" Then
Set objBRef = ent
BlockProp = objBRef.GetDynamicBlockProperties
If objBRef.EffectiveName = "Mega Ramka" And BlockProp(4).Value = "A3-a" And Left(objBRef.EffectiveName, 2) <> "*U" Then
pt1 = objBRef.InsertionPoint
pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
ReDim Preserve pt1(0 To 1)
pt2(0) = pt1(0) + 42000
pt2(1) = pt1(1) + 29700
i = i + 1
PolyPlot "c:\Users\wavaw\Desktop\À3_" + CStr(i), pt1, pt2
End If
End If
Next
End Sub
Sub PolyPlot(strFileName As String, pt1 As Variant, pt2 As Variant)
' We declare
Dim Layout As AcadLayout
' Setting
Set Layout = ThisDrawing.ActiveLayout
Layout.RefreshPlotDeviceInfo
' Print Settings
Layout.ConfigName = "DWG to PDF.pc3"
Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
Layout.CenterPlot = True
Layout.PlotRotation = ac0degrees
Layout.StandardScale = acScaleToFit
Layout.StyleSheet = "monochrome.ctb"
' We set the frame and type of window
Layout.SetWindowToPlot pt1, pt2
Layout.PlotType = acWindow
' We send to the press
ThisDrawing.Regen acAllViewports
ThisDrawing.Plot.PlotToFile strFileName
End Sub