标题: CAD VBA过滤器、选择集分享 [打印本页] 作者: xipick 时间: 2014-8-27 14:08 标题: CAD VBA过滤器、选择集分享 我看到过这个问题有好几次了,当时只是把代码发给了个人,现在把这些代码贴出来,建立一个专题,加以自己的理解进行说明,希望能对大家在工作中遇到选择集和过滤器问题有所帮助以供大家使用。这种方法建立选择集和过滤器我使用过千百遍,未出现过任何异常。
'——————————————————————————————————
'名称:BuildFilter
'作者:罗简单
'日期:2008-3-11
'功能:创建过滤器
'——————————————————————————————————
Public Sub BuildFilter(TypeArray, DataArray, ParamArray gCodes())
Dim fType() As Integer, fData()
Dim index As Long, i As Long
index = LBound(gCodes) - 1
For i = LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve fType(0 To index)
ReDim Preserve fData(0 To index)
fType(index) = CInt(gCodes(i))
fData(index) = gCodes(i + 1)
Next
TypeArray = fType: DataArray = fData
End Sub
'——————————————————————————————————
'名称:CreateSelectionSet
'作者:罗简单
'日期:2008-3-11
'功能:创建选择集
'——————————————————————————————————
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function