'获得图形中存在的块参照列表
Set BlockReferenceList = GetBlockReferences()
'判断是否存在块参照
If BlockReferenceList Is Nothing Then
MsgBox \当前图形中不存在任何的块！\ Exit Sub End If
'刷新块参照列表
Call RefreshList(cboBlockName, BlockReferenceList)
'选择块参照列表中的第一个实体
If cboBlockName.ListIndex = -1 Then cboBlockName.ListIndex = 0 End If
End Sub
'获得图形中存在的块参照列表
Private Function GetBlockReferences() As Collection Dim BlockList As New Collection Dim AcadObject As AcadEntity
Set objDoc = ThisDrawing.Application.ActiveDocument '获得可用的块参照
For Each AcadObject In objDoc.ModelSpace
If AcadObject.ObjectName = \ '不将模型空间、图纸空间和匿名块添加到组合框中
If StrComp(Left(AcadObject.name, 1), \ On Error Resume Next
BlockList.Add AcadObject.name, AcadObject.name End If End If Next
'返回图形中块参照的列表
If BlockList.count > 0 Then
Set GetBlockReferences = BlockList Else
Set GetBlockReferences = Nothing End If End Function
'将组合对象中的元素写入列表框或组合框中
Private Sub RefreshList(ByRef ListObject As Object, ByRef BlockList As Collection)
Dim i As Long '清空列表框
ListObject.Clear
'向列表框中添加新的元素
For i = 1 To BlockList.count
AddSorted ListObject, BlockList(i) Next
End Sub
Private Sub AddSorted(ListObject As Object, SItem As String) '将元素添加到组合框或列表框中，并且排序 Dim i As Long
'元素数目小于1，不进行排序
If ListObject.ListCount = 0 Then ListObject.AddItem SItem Exit Sub End If
'通过比较确定该元素的位置，类似于插入排序法 For i = 0 To (ListObject.ListCount - 1)
If StrComp(ListObject.List(i), SItem, vbTextCompare) = 1 Then ListObject.AddItem SItem, i Exit Sub End If Next
'添加到列表框的最后
ListObject.AddItem SItem
End Sub
Public Sub PaperRotationChange() ' 设置图纸打印方向
If optVertical.Value = True Then
If chkReverse.Value = False Then
objPlotConfiguration.PlotRotation = ac0degrees Else
objPlotConfiguration.PlotRotation = ac180degrees End If
Else
If chkReverse.Value = False Then
objPlotConfiguration.PlotRotation = ac90degrees Else
objPlotConfiguration.PlotRotation = ac270degrees End If End If
' 显示图纸大小 Call SetPlotZone End Sub
' 设置图纸可打印区域大小 Public Sub SetPlotZone()
Dim PaperWidth As Double, PaperHeight As Double, t As Double Dim PlotWidth As Double, PlotHeight As Double
Dim MarginLowerLeft As Variant, MarginUpperRight 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
'单位由“毫米”转换为“英寸”
If optMillimeters.Value = False Then PlotWidth = PlotWidth / 25.4 PlotHeight = PlotHeight / 25.4 End If
' 显示图纸大小
lbPaperSize.Caption = Format(PlotWidth, \ \& Format(PlotHeight, \
End Sub
Private Sub OutputData(objBox As ComboBox, nFile As Integer) Dim i As Integer, count As Integer, index As Integer '获得组合框列表数目
count = objBox.ListCount '获得组合框当前选项的的索引号 index = objBox.ListIndex '输出组合框列表数目 Write #nFile, count
'输出组合框当前选项的的索引号 Write #nFile, index '输出所有的组合框选项 For i = 0 To count - 1
Print #nFile, objBox.List(i) Next
End Sub
Private Sub OutputData2(objBox As CheckBox, nFile As Integer) Dim strTemp As String '输出复选框选中状态
If objBox.Value = True Then strTemp = \是\ Else
strTemp = \否\ End If
Print #nFile, strTemp End Sub
Private Sub OutputData3(objBox As ListBox, nFile As Integer) Dim i As Integer, count As Integer, index As Integer '获得列表框列表数目
count = objBox.ListCount '获得列表框当前选项的的索引号
index = objBox.ListIndex '输出列表框列表数目 Write #nFile, count
'输出列表框当前选项的的索引号 Write #nFile, index '输出所有的列表框选项 For i = 0 To count - 1
Print #nFile, objBox.List(i) Next
End Sub
Private Sub InputData(objBox As ComboBox, nFile As Integer) Dim i As Integer, count As Integer, index As Integer Dim strTemp As String '读入一行文本并存储在变量中 Line Input #nFile, strTemp '读入组合框列表数目 Input #nFile, count
'读入组合框当前元素的的索引号 Input #nFile, index '清空组合框所有元素 objBox.Clear '读入组合框元素
For i = 0 To count - 1
Line Input #nFile, strTemp '将读入的列表添加到组合框中 objBox.AddItem strTemp Next
' 设置组合框初始选项 With objBox
'使用下拉列表的形式
.Style = fmStyleDropDownList '设置下拉列表的下标下限 .BoundColumn = 0 '设置默认的显示项目 .ListIndex = index End With
End Sub
Private Sub InputData2(objBox As CheckBox, nFile As Integer) Dim strTemp As String '读入一行文本并存储在变量中