'快速打印
Function KSDY2(P1 As Variant, P2 As Variant)


    Dim PtMin As Variant
    Dim PtMax As Variant
    PtMin = P1
    PtMax = P2
    
    ReDim Preserve PtMin(0 To 1)
    ReDim Preserve PtMax(0 To 1)
    
    
    
    ' 设置打印比例为“布满图纸”
    ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
    
    ThisDrawing.ActiveLayout.SetWindowToPlot PtMin, PtMax
    ' 设置打印类型为窗口
    ThisDrawing.ActiveLayout.PlotType = acWindow
    '设置为居中打印
    ThisDrawing.ActiveLayout.CenterPlot = True

    If Me.OptionButton4.Value = True Then
        '启用打印预览
        
        ThisDrawing.ActiveLayout.GetWindowToPlot PtMin, PtMax
        
        ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    Else
        '打印当前的区域
        '若选中“打印到文件”
        If PlotTofile_CheckBox.Value Then
            If PlotFilesPath_ComboBox.text = "" Then PlotFilesPath_ComboBox.text = GetPath
            ThisDrawing.Plot.PlotToFile PlotFilesPath_ComboBox.text & ThisDrawing.Name & "-" & N & ".plt"
            N = N + 1
        Else
            ThisDrawing.Plot.PlotToDevice ThisDrawing.ModelSpace.Layout.ConfigName
        End If
    End If
End Function

 '不知道为什么， 'ThisDrawing.ActiveLayout.CenterPlot = True 这句有的时候，出现PlotOrigin 不定，
'而且使用GetBoundingBox获取对象的角点有的时候也不太好用。还是使用getPoint比较实在。
Sub xPrint2()
    Dim P1 As Variant
    Dim P2 As Variant
    Dim W As Double
    Dim H As Double
    Dim W1 As Double
    Dim H1 As Double
    Dim xOrigin(1) As Double
    Dim xScale(1) As Double
    Dim S As Double
    Dim R
    On Error Resume Next
    P1 = ThisDrawing.Utility.GetPoint(, "打印窗口的角点:")
    P2 = ThisDrawing.Utility.GetPoint(P1, "打印窗口的另一个角点:")
E:
    On Error GoTo F:
    ReDim Preserve P1(0 To 1)
    ReDim Preserve P2(0 To 1)
    ThisDrawing.ActiveLayout.GetPaperSize W, H
    Prompt str(W) & " / " & str(H) & vbCrLf
    W1 = Abs(P1(0) - P2(0)): H1 = Abs(P1(1) - P2(1))
    Prompt str(W1) & " / " & str(H1) & vbCrLf
    R = ThisDrawing.ActiveLayout.PlotRotation
    
    If R = ac0degrees Or R = ac180degrees Then
        xScale(0) = W1 / W
        xScale(1) = H1 / H
        If xScale(0) >= xScale(1) Then
           S = xScale(0)
        Else
           S = xScale(1)
        End If
        Prompt str(S) & vbCrLf
        ThisDrawing.ActiveLayout.SetCustomScale 1, S
        xOrigin(0) = Abs(W1 / S - W) / 2
        Prompt str(xOrigin(0)) & vbCrLf
        xOrigin(1) = Abs(H1 / S - H) / 2
        Prompt str(xOrigin(1)) & vbCrLf
    ElseIf R = ac90degrees Or R = ac270degrees Then
        xScale(0) = H1 / W
        xScale(1) = W1 / H
        If xScale(0) >= xScale(1) Then
           S = xScale(0)
        Else
           S = xScale(1)
        End If
        Prompt str(S) & vbCrLf
        ThisDrawing.ActiveLayout.SetCustomScale 1, S
        xOrigin(0) = Abs(H1 / S - W) / 2
        Prompt str(xOrigin(0)) & vbCrLf
        xOrigin(1) = Abs(W1 / S - H) / 2
        Prompt str(xOrigin(1)) & vbCrLf
    End If
    ThisDrawing.ActiveLayout.PlotOrigin = xOrigin
    ThisDrawing.ActiveLayout.SetWindowToPlot P1, P2
    ThisDrawing.ActiveLayout.GetWindowToPlot P1, P2
    ThisDrawing.ActiveLayout.PlotType = acWindow
    ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    'ThisDrawing.Plot.PlotToDevice ThisDrawing.ModelSpace.Layout.ConfigName
    P1 = ThisDrawing.Utility.GetPoint(, "打印窗口的角点:")
    P2 = ThisDrawing.Utility.GetPoint(P1, "打印窗口的另一个角点:")
    GoTo E:
F:
End Sub

   '重新指定原点，防止漂移
    ThisDrawing.ModelSpace.Layout.PlotOrigin = originalValue
…………

    '必须保存原始原点，否则打印会随机飘动？
    Dim originalValue As Variant
    originalValue = ThisDrawing.ModelSpace.Layout.PlotOrigin