社区 › VB › [原创]打印函数

lennie 发表于 2009-5-30 15:47:00

[原创]打印函数

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.ConfigNamePlot_Device Then ThisDrawing.ActiveLayout.ConfigName = Plot_Device
    End If
    If Style_Sheet"" Then
      If ThisDrawing.ActiveLayout.StyleSheetStyle_Sheet Then ThisDrawing.ActiveLayout.StyleSheet = Style_Sheet
    End If
    If CanonicalMedia"" Then
      If ThisDrawing.ActiveLayout.CanonicalMediaNameCanonicalMedia 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

lennie 发表于 2009-5-30 15:54:00

有人看了我的Flash向我要源码 就放到这里吧 顺便赚点积分
不是专业人员 很多地方写得不专业 请见谅
函数参数说明：
zx,ys打印区域左下点坐标(用string传递主要是参数表太长了，呵呵，很不专业 有空的话可以改成数组)
P_Option 打印方式
   0 不操作（仅设置打印区域）
   1 打印到设备
   2打印到文件
其他参数应该很容易看懂的。另外Degree= "自 动" 就是可以根据打印区域的高宽比自动选纸张大小。

halop 发表于 2010-5-27 20:35:00

用什么写的啊？

3xxx 发表于 2013-6-3 21:07:00

这个记下了研究一下。

查看完整版本: [原创]打印函数