[原创]打印函数

Public Function P_DWG(ByVal ZX As String, ByVal YS As String, Optional ByVal P_Option _
    As Integer = 1, Optional ByVal Paper_Units As String = "毫米", Optional ByVal CustomScale As Long = 0, Optional _
    ByVal Plot_Device As String = "", Optional ByVal Style_Sheet As String = "", Optional ByVal CanonicalMedia As _
    String = "", Optional ByVal File_Path As String = "", Optional ByVal Number_Copies As Integer = 1, Optional ByVal _
    Plot_Origin As String = ",", Optional ByVal Degree As String = "自 动") As Long
'P_DWG 返回值：
'   1       操作成功
'   0       操作被用户中断
'   -1      接口使用错误
'   -2      函数内部错误
On Error GoTo Err_handle
    Dim FilePath As String
    FilePath = File_Path
    If Plot_Device  "" Then
        If ThisDrawing.ActiveLayout.ConfigName  Plot_Device Then ThisDrawing.ActiveLayout.ConfigName = Plot_Device
    End If
    If Style_Sheet  "" Then
        If ThisDrawing.ActiveLayout.StyleSheet  Style_Sheet Then ThisDrawing.ActiveLayout.StyleSheet = Style_Sheet
    End If
    If CanonicalMedia  "" Then
        If ThisDrawing.ActiveLayout.CanonicalMediaName  CanonicalMedia Then ThisDrawing.ActiveLayout.CanonicalMediaName = CanonicalMedia
    End If
    If Not Exists(Left(FilePath, InStrRev(FilePath, ""))) And P_Option = 2 Then
        P_DWG = -2
        Exit Function
    End If
    If Val(ThisDrawing.Application.Version) >= 16.2 Then
        ThisDrawing.SetVariable "BACKGROUNDPLOT", 0
    End If
    '获取后缀名
    Dim Extension As String
    Extension = ".plt"
    If InStr(1, Plot_Device, "png", 1) Then Extension = ".png"
    If InStr(1, Plot_Device, "tif", 1) Then Extension = ".tif"
    
    '设置打印区域
    Dim P1(0 To 1) As Double
    Dim P2(0 To 1) As Double
    P1(0) = Val(ZX)
    P1(1) = Val(Right(ZX, Len(ZX) - InStr(ZX, ",")))
    P2(0) = Val(YS)
    P2(1) = Val(Right(YS, Len(YS) - InStr(YS, ",")))
'    Dim W As Double
'    Dim H As Double
'    W = P2(0) - P1(0)
'    H = P2(1) - P1(1)
'    P1(0) = P1(0) - 0.001 * W
'    P1(1) = P1(1) - 0.001 * H
'    P2(0) = P2(0) + 0.001 * W
'    P2(1) = P2(1) + 0.001 * H
    ThisDrawing.ActiveLayout.SetWindowToPlot P1, P2
    ThisDrawing.ActiveLayout.PlotType = acWindow
     '设置旋转角度
    Select Case Degree
        Case "自 动"
            Dim zW As Double
            Dim zH As Double
            Dim tW As Double
            Dim tH As Double
            Dim str1 As String
            Dim str2 As String
            zW = Abs(Val(ZX) - Val(YS))
            str1 = Right(ZX, Len(ZX) - InStr(ZX, ","))
            str2 = Right(YS, Len(YS) - InStr(YS, ","))
            zH = Abs(Val(str1) - Val(str2))
            ThisDrawing.ActiveLayout.GetPaperSize tW, tH
            If ((tW > tH) And (zW > zH)) Or ((tW = 16.2 Then
        ThisDrawing.SetVariable "BACKGROUNDPLOT", 2
    End If
    Exit Function
Err_handle:
    Select Case Err.Number
        Case -2145386493        '打印单位设置错误
            P_DWG = -1
        Case Else
            P_DWG = -2
    End Select
End Function