打印所有打开的dwg (PS选项卡)

Option Explicit
Public Sub PlotAll()
      Dim dwg As AcadDocument, dwgs As AcadDocuments
      Set dwgs = Application.Documents
      Dim PSLayout As AcadLayout, PSLayouts As AcadLayouts
      For Each dwg In dwgs
            Set PSLayouts = ThisDrawing.Layouts
            For Each PSLayout In PSLayouts
                  SetupAndPlot
            Next
      Next
End Sub
Private Sub SetupAndPlot()      'ByRef Plotter As String, CTB As String, SIZE As String, PSCALE As String, ROT As String) ' either pass these or hard code below
      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
      Layout.ScaleLineweights = False
      Layout.RefreshPlotDeviceInfo
      ThisDrawing.Regen acAllViewports
      ZoomExtents
      Set Layout = Nothing
      ThisDrawing.Save
      ThisDrawing.Plot.PlotToDevice
      ThisDrawing.Close (True)
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