TheSwamp

Code Red => VB(A) => Topic started by: Matersammichman on February 22, 2007, 10:55:01 AM

Title: Plot all open dwg (PS Tabs)
Post by: Matersammichman on February 22, 2007, 10:55:01 AM

Anyone have any code to loop through all open dwgs and plot all PS tabs on each?

Title: Re: Plot all open dwg (PS Tabs)
Post by: David Hall on February 22, 2007, 11:30:13 AM

Not exactly, but would be easy enough to modify what I have

Title: Re: Plot all open dwg (PS Tabs)
Post by: David Hall on February 22, 2007, 11:31:13 AM

Are you using the same plot settings for each layout?

Title: Re: Plot all open dwg (PS Tabs)
Post by: David Hall on February 22, 2007, 11:40:05 AM

This should get you started

Code: [Select]

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


Title: Re: Plot all open dwg (PS Tabs)
Post by: David Hall on February 22, 2007, 11:41:10 AM

I didn't test this yet, but it looks like you will have to set each layout current, then it will work.

Title: Re: Plot all open dwg (PS Tabs)
Post by: Matersammichman on February 22, 2007, 12:30:07 PM

Thanks, I'll give it a shot.