CADVBA批量打印

Debug.Print ptMin(0) & \

If Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 1.414) < 0.01 Or Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 0.707) < 0.01 Then IsFrame = True End If End If End Function

Function SNA11x17()

Dim objPS As AcadPlotConfiguration

Set objPS = ThisDrawing.PlotConfigurations.Add(“SNA-AZTU-11x17”, False)

objPS.ConfigName = “\\\\SERVER2\\SAVIN 4035 PCL 6” objPS.CanonicalMediaName = “Tabloid” objPS.CenterPlot = True

objPS.PaperUnits = acInches objPS.PlotHidden = False

objPS.PlotRotation = ac90degrees objPS.PlotType = acExtents

objPS.PlotViewportBorders = False objPS.PlotViewportsFirst = True objPS.PlotWithLineweights = True objPS.PlotWithPlotStyles = True objPS.ScaleLineweights = False objPS.ShowPlotStyles = False

objPS.StandardScale = acScaleToFit objPS.StyleSheet = “SNA-11X17.ctb” objPS.UseStandardScale = True 二

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.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 Exit_Here: Exit Sub Err_Control:

Select Case Err.Number Case \

MsgBox \

MsgBox \TPSTYLES command\ Case Else

MsgBox \三

Sub PcsMM()

Dim pC As AcadPlotConfiguration Dim PCs As AcadPlotConfigurations Dim oLayout As AcadLayout Dim oLayouts As AcadLayouts Dim PlotOrig(1) As Double Dim Orig Set oLayouts = ThisDrawing.Layouts

Set PCs = ThisDrawing.PlotConfigurations Set oLayout = ThisDrawing.PaperSpace.Layout PlotOrig(0) = 18.542: PlotOrig(1) = 12.192

Set pC = PCs.Add(\ .PlotType = acExtents

.CanonicalMediaName = \ .ConfigName = \\\\DESIGNSERVER\\HPDJ

.PlotOrigin = PlotOrig

.PlotRotation = ac180degrees .StandardScale = ac1_1 End With PcTyp pC oLayout.CopyFrom pC

PlotOrig(0) = 19.01: PlotOrig(1) = 12.68 Set pC = PCs.Add(\ .PlotType = acLayout

.CanonicalMediaName = \

.ConfigName = \gin = PlotOrig

.PlotRotation = ac180degrees .StandardScale = ac1_1 End With PcTyp pC oLayout.CopyFrom pC

PlotOrig(0) = 1.31: PlotOrig(1) = 4.48 Set pC = PCs.Add(\

.PlotType = acExtents .CenterPlot = True

.ConfigName = \ PlotOrig

.PlotRotation = ac270degrees .StandardScale = ac1_2

'.CanonicalMediaName = \PcTyp pC 'ModelSpace

Set oLayout = ThisDrawing.ModelSpace.Layout

Set pC = PCs.Add(\

.ConfigName = \ .CanonicalMediaName = \ .PlotRotation = ac180degrees End With PCAdds pC

Set pC = PCs.Add(\

.ConfigName = \ .CanonicalMediaName = \ .PlotRotation = ac180degrees End With PcTyp pC

Set pC = PCs.Add(\

Orig = ThisDrawing.GetVariable(\h pC

.ConfigName = \mScale 1, 1

.CanonicalMediaName = \ .PlotOrigin = PlotOrig

.PlotRotation = ac270degrees End With PcTyp pC oLayout.CopyFrom pC

'Pc.RefreshPlotDeviceInfo ThisDrawing.Regen 0 End Sub

Function PcTyp(pC As AcadPlotConfiguration)

With pC

.PaperUnits = acMillimeters .PlotHidden = False

.PlotViewportBorders = False .PlotViewportsFirst = True .PlotWithLineweights = True .PlotWithPlotStyles = True

.StyleSheet = \End Function