田草博客

'不知道为什么， '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