[原创]打印函数
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 < tH) And (zW < zH)) Then
ThisDrawing.ActiveLayout.PlotRotation = ac0degrees
Else
ThisDrawing.ActiveLayout.PlotRotation = ac90degrees
End If
Case "0度"
ThisDrawing.ActiveLayout.PlotRotation = ac0degrees
Case " 90度"
ThisDrawing.ActiveLayout.PlotRotation = ac90degrees
Case "180度"
ThisDrawing.ActiveLayout.PlotRotation = ac180degrees
Case "270度"
ThisDrawing.ActiveLayout.PlotRotation = ac270degrees
Case Else
P_DWG = -1
ThisDrawing.SetVariable "BACKGROUNDPLOT", 2
Exit Function
End Select
'设置打印比例，Paper_Units控制尺寸单位
Select Case Paper_Units
Case "英寸"
ThisDrawing.ActiveLayout.PaperUnits = acInches
Case "毫米"
ThisDrawing.ActiveLayout.PaperUnits = acMillimeters
Case "像素"
ThisDrawing.ActiveLayout.PaperUnits = acPixels
Case Else
P_DWG = -1
ThisDrawing.SetVariable "BACKGROUNDPLOT", 2
Exit Function
End Select
If CustomScale < 0 Then
P_DWG = -1
ThisDrawing.SetVariable "BACKGROUNDPLOT", 2
Exit Function
End If
If CustomScale = 0 Then
ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
Else
ThisDrawing.ActiveLayout.SetCustomScale 1, CustomScale
End If
'设置偏移量
Dim NewValue(0 To 1) As Double
If Plot_Origin = "," Or Plot_Origin = "0,0" Then
ThisDrawing.ActiveLayout.CenterPlot = True
Else
NewValue(0) = Val(Plot_Origin)
NewValue(1) = Val(Right(Plot_Origin, Len(Plot_Origin) - InStr(Plot_Origin, ",")))
ThisDrawing.ActiveLayout.PlotOrigin = NewValue
End If '设置打印份数
ThisDrawing.Plot.NumberOfCopies = Number_Copies
'区分打印的类型
Select Case P_Option
Case 0'空操作
P_DWG = 1
Exit Function
Case 1 '打印到设备
If ThisDrawing.Plot.PlotToDevice Then P_DWG = 1 Else P_DWG = 0
Case 2 '打印到文件
If Exists(FilePath & Extension) Then
If MsgBox(FilePath & Extension & " 已经存在。是否覆盖原文件？", vbYesNo, "覆盖文件") = vbYes Then
If ThisDrawing.Plot.PlotToFile(FilePath & Extension) Then P_DWG = 1 Else P_DWG = 0
End If
Else
If ThisDrawing.Plot.PlotToFile(FilePath & Extension) Then P_DWG = 1 Else P_DWG = 0
End If
Case 3 '打印预览
ThisDrawing.Plot.DisplayPlotPreview acFullPreview
P_DWG = 1
Case Else
P_DWG = -1
End Select
If Val(ThisDrawing.Application.Version) >= 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 <p>有人看了我的Flash向我要源码 就放到这里吧 顺便赚点积分</p><p>不是专业人员 很多地方写得不专业 请见谅</p><p>函数参数说明：</p><p>zx,ys打印区域左下点坐标(用string传递主要是参数表太长了，呵呵，很不专业 有空的话可以改成数组)</p><p>P_Option 打印方式<br/> 0 不操作（仅设置打印区域）<br/> 1 打印到设备<br/> 2打印到文件</p><p>其他参数应该很容易看懂的。另外Degree= "自 动" 就是可以根据打印区域的高宽比自动选纸张大小。</p> <p>用什么写的啊？</p> 这个记下了研究一下。
页:
[1]