[编程交流] 带VBA的Pdf批次

Sub PDF()
Dim xymin As Variant
Dim xymax As Variant
Dim sysVarName As String
Dim varData As Variant
Dim blad As AcadLayout
Dim PlotXY(0 To 1) As Double
Dim i As Integer
Dim result As Boolean
On Error GoTo PDF_Error
Set blad = ThisDrawing.Layouts.Item(1)
ThisDrawing.ActiveLayout = blad
blad.ConfigName = "DWG To PDF.pc3"
blad.CanonicalMediaName = "ISO_A3_(420.00_x_297.00_MM)"
blad.PlotType = acExtents
blad.StandardScale = acScaleToFit
blad.CenterPlot = True
blad.ScaleLineweights = True
blad.StyleSheet = "acad.ctb"
blad.PlotWithPlotStyles = False
blad.PlotWithLineweights = False
PlotXY(0) = 0#
PlotXY(1) = 0#
sysVarName = "EXTMIN"
xymin = ThisDrawing.GetVariable(sysVarName)
sysVarName = "EXTMAX"
xymax = ThisDrawing.GetVariable(sysVarName)
If (xymax(0) - xymin(0)) > (xymax(1) - xymin(1)) Then
blad.PlotRotation = ac0degrees
Else
blad.PlotRotation = ac90degrees
End If
blad.PaperUnits = acMillimeters
result = ThisDrawing.Plot.PlotToFile(Replace(ThisDrawing.FullName, "dwg", "pdf"))
Exit Sub
PDF_Error:
MsgBox "Error PDF'ing Layout!", vbOKOnly, "Error"
End Sub