Option Explicit '图形集合
Private colDwgs As New Collection '文档对象
Private objDoc As AcadDocument '布局对象
Private objLayout As AcadLayout '打印配置集合
Private objPlotConfigurations As AcadPlotConfigurations '打印配置
Private objPlotConfiguration As AcadPlotConfiguration Private objOriginalPC As AcadPlotConfiguration '打印对象
Private objPlot As AcadPlot '图纸尺寸名称数组
Private paperSizes As Variant
Private Numerator As Double, Denominator As Double Private OffsetX As Double, OffsetY As Double Private ms As Boolean
Private Type BrowseInfo hOwner As Long pidlRoot As Long
pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type
Private Const MAX_PATH = 260 '代表ESC键
Private Const VK_ESCAPE = &H1B
'API函数的声明
Private Declare Function SHBrowseForFolder Lib \
Alias \
Private Declare Function FindWindow Lib \Alias \(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SHGetPathFromIDList Lib \Alias \
pidl As Long, ByVal pszPath As String) As Long
Private Declare Function GetAsyncKeyState Lib \(ByVal vKey As
Long) As Integer
' 功能：判断用户是否按下某一个键
' 输入：代表键的常量（从API Viewer中获得） ' 调用：API函数GetAsyncKeyState
' 返回：如果用户按下了指定的键，返回True；否则返回False ' 示例：
' If CheckKey(&H1B) = True Then do sth
Private Function CheckKey(lngKey As Long) As Boolean If GetAsyncKeyState(lngKey) Then CheckKey = True Else
CheckKey = False End If
End Function
Private Sub cboPaperSize_Change() '若组合框非空
If cboPaperSize.Text <> \ ' 设置图纸尺寸 objPlotConfiguration.CanonicalMediaName = paperSizes(cboPaperSize.ListIndex) ' 显示图纸尺寸 Call SetPlotZone
' 当居中打印时重新计算打印偏移
If chkCenterPlot.Value Then Call SetOffset End If End Sub
Private Sub cboPlotScale_Click() '定义图纸尺寸数组 Dim Nu, De '定义分子数组
Nu = Array(\ \ \ \ '定义分母数组
De = Array(\
\_
\ \
'设置默认的显示项目
If cboPlotScale.ListIndex = 0 Then '使用自定义比例 Numerator = 1 Denominator = 1
txtNumerator.Text = Numerator
txtDenominator.Text = Denominator Else
If cboPlotScale.ListIndex > 1 Then
Numerator = Nu(cboPlotScale.ListIndex) Denominator = De(cboPlotScale.ListIndex) txtNumerator.Text = Numerator
txtDenominator.Text = Denominator Else
'计算缩放比例
Call SetScaleToFit End If End If Dim Q1
'定义组合框索引到打印比例枚举值的映射
Q1 = Array(100, 0, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, _
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15) ' 设置图纸打印比例
If cboPlotScale.ListIndex <> 0 Then '使用标准打印比例
objPlotConfiguration.UseStandardScale = True '设置标准打印比例
objPlotConfiguration.StandardScale = Q1(cboPlotScale.ListIndex) Else
'使用自定义打印比例
objPlotConfiguration.UseStandardScale = False '设置自定义打印比例
objPlotConfiguration.SetCustomScale Numerator, Denominator End If
' 当居中打印时重新计算打印偏移
If chkCenterPlot.Value Then Call SetOffset
End Sub
Private Sub cboPlotStyleTableNames_Change() ' 设置打印样式表
objPlotConfiguration.StyleSheet = cboPlotStyleTableNames.Text
End Sub
Private Sub cboPrintersName_Click() '设置打印机配置
objPlotConfiguration.ConfigName = cboPrintersName.Text '更新显示AutoCAD中当前可用的所有图纸尺寸 Call ListPaperSize End Sub
Private Sub chkCenterPlot_Click() On Error Resume Next
If chkCenterPlot.Value Then ' 设置图纸是否居中打印
objPlotConfiguration.CenterPlot = True '计算打印偏移 Call SetOffset Else
' 设置图纸是否居中打印
objPlotConfiguration.CenterPlot = False OffsetX = 0 OffsetY = 0 '设置文本框文本
txtOffsetX.Text = \ txtOffsetY.Text = \ End If
End Sub
Public Sub SetOffset()
'On Error Resume Next
Dim PaperWidth As Double, PaperHeight As Double, t As Double Dim PlotWidth As Double, PlotHeight As Double
Dim WindowWidth As Double, WindowHeight As Double
Dim MarginLowerLeft As Variant, MarginUpperRight As Variant Dim WindowLowerLeft As Variant, WindowUpperRight As Variant '刷新打印设备信息
objPlotConfiguration.RefreshPlotDeviceInfo '取得图纸尺寸信息
objPlotConfiguration.GetPaperSize PaperWidth, PaperHeight '取得图纸边界信息 objPlotConfiguration.GetPaperMargins MarginLowerLeft, MarginUpperRight '计算打印区域
PlotWidth = PaperWidth - (MarginUpperRight(0) + MarginLowerLeft(0))
PlotHeight = PaperHeight - (MarginUpperRight(1) + MarginLowerLeft(1)) '根据选择的图形方向调换宽高 If optVertical.Value Then
'图形方向为“纵向”时宽小于高
If PlotWidth > PlotHeight Then t = PlotWidth
PlotWidth = PlotHeight PlotHeight = t End If Else
'图形方向为“横向”时宽大于高
If PlotWidth < PlotHeight Then t = PlotWidth
PlotWidth = PlotHeight PlotHeight = t End If End If
'单位由“英寸”转换为“毫米”的比例因子 Dim scaleUnit As Double
scaleUnit = IIf(optMillimeters.Value, 1, 25.4) '获得打印窗口尺寸 objPlotConfiguration.GetWindowToPlot WindowLowerLeft, WindowUpperRight
WindowWidth = WindowUpperRight(0) - WindowLowerLeft(0) WindowHeight = WindowUpperRight(1) - WindowLowerLeft(1) '获得缩放后的打印窗口尺寸
WindowWidth = WindowWidth * Numerator / Denominator * scaleUnit WindowHeight = WindowHeight * Numerator / Denominator * scaleUnit '计算打印偏移
OffsetX = (PlotWidth - WindowWidth) / 2 OffsetY = (PlotHeight - WindowHeight) / 2 Dim X As Double, Y As Double '单位由“毫米”转换为“英寸”
X = IIf(optMillimeters.Value, OffsetX, OffsetX / 25.4) Y = IIf(optMillimeters.Value, OffsetY, OffsetY / 25.4) '设置文本框文本
txtOffsetX.Text = Format(X, \ txtOffsetY.Text = Format(Y, \
End Sub
Private Sub chkOnlyPlotThis_Change() '设置“打印到文件”组各控件激活状态