cad打印代码

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))