lbUnitX.Caption = \毫米\ lbUnitY.Caption = \毫米\
lbPaperUnit.Caption = \毫米\
Denominator = Denominator / 25.4
txtDenominator.Text = Format(Denominator, \ txtOffsetX.Text = Format(OffsetX, \ txtOffsetY.Text = Format(OffsetY, \ ElseIf (optMillimeters.Value = False And ms = True) Then '设置图纸单位
objPlotConfiguration.PaperUnits = acInches '修改标签
lbUnit.Caption = \英寸 ＝\ lbUnitX.Caption = \英寸\ lbUnitY.Caption = \英寸\
lbPaperUnit.Caption = \英寸\
Denominator = Denominator * 25.4
txtDenominator.Text = Format(Denominator, \ txtOffsetX.Text = Format(OffsetX / 25.4, \ txtOffsetY.Text = Format(OffsetY / 25.4, \ End If
'非“按图纸空间缩放”时由标准比例变为自定义比例
If cboPlotScale.ListIndex > 1 Then cboPlotScale.ListIndex = 0
'显示图纸尺寸 Call SetPlotZone
ms = optMillimeters.Value End Sub
Private Sub OptVertical_Change() '设置图纸打印方向
Call PaperRotationChange
'当图纸比例选项为“按图纸空间缩放”时重新计算缩放比例 If cboPlotScale.ListIndex = 1 Then Call SetScaleToFit ' 当居中打印时重新计算打印偏移
If chkCenterPlot.Value Then Call SetOffset
End Sub
Private Sub spnAngle_SpinDown() If CInt(txtNumber.Text) > 1 Then
txtNumber.Text = CInt(txtNumber.Text) - 1 End If
End Sub
Private Sub spnAngle_SpinUp()
txtNumber.Text = CInt(txtNumber.Text) + 1 End Sub
Private Sub txtCurPath_Change() '查找文件，向列表框中添加
If Len(Dir(txtCurPath.Text)) > 0 Then
FindFile colDwgs, txtCurPath.Text, \ If AddToList(lstCurFiles, colDwgs) Then End If End If End Sub
Private Sub txtDenominator_KeyUp(ByVal KeyCode MSForms.ReturnInteger, ByVal Shift As Integer) ' 设置自定义图纸尺寸
If IsNumeric(CDbl(txtDenominator.Text)) Then Dim strTemp As String '记住文本框文本
strTemp = txtDenominator.Text '设置组合框显示项目为“自定义” cboPlotScale.ListIndex = 0
'恢复文本框文字（上步操作有时会导致文本框值归1） txtDenominator.Text = strTemp '将文本框文本转换为实数
Denominator = CDbl(txtDenominator.Text) '使用自定义打印比例
objPlotConfiguration.UseStandardScale = False '设置自定义打印比例
objPlotConfiguration.SetCustomScale Numerator, Denominator ' 当居中打印时重新计算打印偏移
If chkCenterPlot.Value Then Call SetOffset Else
MsgBox \请输入数字！\ End If End Sub
Private Sub txtNumerator_KeyUp(ByVal KeyCode MSForms.ReturnInteger, ByVal Shift As Integer) ' 设置自定义图纸尺寸
If IsNumeric(CDbl(txtNumerator.Text)) Then Dim strTemp As String
As
As
'记住文本框文本
strTemp = txtNumerator.Text '设置组合框显示项目为“自定义” cboPlotScale.ListIndex = 0
'恢复文本框文字（上步操作有时会导致文本框值归1） txtNumerator.Text = strTemp '将文本框文本转换为实数
Numerator = CDbl(txtNumerator.Text) '使用自定义打印比例
objPlotConfiguration.UseStandardScale = False '设置自定义打印比例
objPlotConfiguration.SetCustomScale Numerator, Denominator ' 当居中打印时重新计算打印偏移
If chkCenterPlot.Value Then Call SetOffset Else
MsgBox \请输入数字！\ End If End Sub
Private Sub txtOffsetX_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) ' 输入检查
If Not ((KeyAscii >= Asc(\Asc(\ MsgBox \请输入数字！\ End If End Sub
Private Sub txtOffsetX_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) On Error Resume Next ' 设置自定义图纸尺寸
If IsNumeric(CDbl(txtOffsetX.Text)) Then Dim strTemp As String '记住文本框文本
strTemp = txtOffsetX.Text '将文本框文本转换为实数
OffsetX = CDbl(txtOffsetX.Text) '取消“居中打印”复选框
chkCenterPlot.Value = False
'恢复文本框文字（上步操作有时会导致文本框值归零） txtOffsetX.Text = strTemp
Dim ptPlotOrigin(0 To 1) As Double '设置自定义打印偏移
'图形方向为“横向”时宽高互调
ptPlotOrigin(0) = IIf(optVertical.Value, OffsetX, OffsetY) ptPlotOrigin(1) = IIf(optVertical.Value, OffsetY, OffsetX) objPlotConfiguration.CenterPlot = False
objPlotConfiguration.PlotOrigin = ptPlotOrigin Else
MsgBox \请输入数字！\ End If End Sub
Private Sub txtOffsetY_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) ' 输入检查
If Not ((KeyAscii >= Asc(\Asc(\ MsgBox \请输入数字！\ End If End Sub
Private Sub txtOffsetY_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) On Error Resume Next ' 设置自定义图纸尺寸
If IsNumeric(CDbl(txtOffsetY.Text)) Then Dim strTemp As String '记住文本框文本
strTemp = txtOffsetY.Text '将文本框文本转换为实数
OffsetY = CDbl(txtOffsetY.Text) '取消“居中打印”复选框
chkCenterPlot.Value = False
'恢复文本框文字（上步操作有时会导致文本框值归零） txtOffsetY.Text = strTemp
Dim ptPlotOrigin(0 To 1) As Double '设置自定义打印偏移
'图形方向为“横向”时宽高互调
ptPlotOrigin(0) = IIf(optVertical.Value, OffsetX, OffsetY) ptPlotOrigin(1) = IIf(optVertical.Value, OffsetY, OffsetX) objPlotConfiguration.CenterPlot = False
objPlotConfiguration.PlotOrigin = ptPlotOrigin Else
MsgBox \请输入数字！\ End If End Sub
Private Sub UserForm_Initialize()
On Error Resume Next '取得当前文档对象
Set objDoc = ThisDrawing.Application.ActiveDocument '取得当前布局对象
Set objLayout = ThisDrawing.ActiveLayout '取得当前打印对象
Set objPlot = ThisDrawing.Plot '从文件对象取得打印配置集合
Set objPlotConfigurations = ThisDrawing.PlotConfigurations '清空以前的打印配置集合
For Each objPlotConfiguration In objPlotConfigurations objPlotConfiguration.Delete Next
'添加打印配置
Set objOriginalPC = objPlotConfigurations.Add(\原来的打印配置\ Set objPlotConfiguration = objPlotConfigurations.Add(\我的打印配置\True)
'复制打印配置
objOriginalPC.CopyFrom objLayout
objPlotConfiguration.CopyFrom objLayout '重命名打印配置
objOriginalPC.name = \原来的打印配置\
objPlotConfiguration.name = \我的打印配置\
'禁用“当前路径”文本框
txtCurPath.Enabled = False
'设置图纸单位
If objOriginalPC.PaperUnits = acInches Then optInches.Value = True Else
optMillimeters.Value = True End If
'记录上次的图纸单位设置 ms = optMillimeters.Value
'设置图纸方向
Call GetPlotRotation '刷新打印机列表
Call ListPlotDeviceNames '刷新打印样式表
Call ListPlotStyleTableNames '刷新打印比例列表 Call ListPlotScale