[编程交流] 使用VBA打印

Sub Example_GetPaperSize() 
'This example gets the width and height of the default paper size for 'your system. 
Dim PaperWidth As Double, PaperHeight As Double 
ThisDrawing.ActiveLayout.GetPaperSize PaperWidth, PaperHeight 
MsgBox "The default paper size is " & vbCrLf & _ 
 "Width: " & PaperWidth & vbCrLf & _ 
 "Height: " & PaperHeight
 End Sub

Public Sub SetupAndPlot(ByRef Plotter As String, CTB As String, SIZE As String, PSCALE As String, ROT As String)
     Dim Layout As AcadLayout
     On Error GoTo Err_Control
     Set Layout = ThisDrawing.ActiveLayout
     Layout.RefreshPlotDeviceInfo
     Layout.ConfigName = Plotter    ' CALL PLOTTER
     Layout.PlotType = acExtents
     Layout.PlotRotation = ROT    ' CALL ROTATION
     Layout.StyleSheet = CTB    ' CALL CTB FILE
     Layout.PlotWithPlotStyles = True
     Layout.PlotViewportBorders = False
     Layout.PlotViewportsFirst = True
     Layout.CanonicalMediaName = SIZE    ' CALL SIZE
     Layout.PaperUnits = acInches
     Layout.StandardScale = PSCALE    'CALL PSCALE
     Layout.ShowPlotStyles = False
     ThisDrawing.Plot.NumberOfCopies = 1
     Layout.CenterPlot = True
     If SIZE = "ARCH_expand_C_(24.00_x_18.00_Inches)" Then
           Layout.ScaleLineweights = True
     End If
     ThisDrawing.Regen acAllViewports
     ZoomExtents
     Set Layout = Nothing
     ThisDrawing.Save
Exit_Here:
     Exit Sub
Err_Control:
     Select Case Err.Number
     Case "-2145320861"
           MsgBox "Unable to Save Drawing- " & Err.Description
     Case "-2145386493"
           MsgBox "Drawing is setup for Named Plot Styles." & (Chr(13)) & (Chr(13)) & "Run CONVERTPSTYLES command", vbCritical, "Change Plot Style"
     Case Else
           MsgBox "Unknown Error " & Err.Number
     End Select
End Sub

Public Sub Vendor1117()
     Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
     ThisDrawing.Plot.PlotToDevice
           ThisDrawing.Close (True)
End Sub