I see quite a few people struggling to create selection sets using VB/VBA, well two functions, BuildFilter from Frank Oquendo and vbdPowerSet from Randall Rath, make this task much easier.
Randall's routine vbdPowerSet, makes creating selection sets within a drawing a much easier process:
CODE
Public Function vbdPowerSet(strName As String) As AcadSelectionSet ' ' Title : vbdPowerSet ' ' Version : 1.0.0 ' Author(s) : Randall Rath ' Created : 03/20/2002 01:45:37 PM ' Last Edit : 03/20/2002 01:45:37 PM, TDC ' ' Description: ' »»»»»»»»»»»» ' This function to add a new selection set by name, and check ' for an existing selection set. ' ' Additional files/functions required: ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»» ' 1) None ' ' Example usage: ' »»»»»»»»»»»»»» ' Set ssTitleBlocks = vbdPowerSet("TITLEBLOCKS_SSET") ' ' Requires the following variables: ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»» ' * Input assignments ' 1) strName - A string for any named sets within the ' drawing for vbdPowerSet to search. ' ' Updates: ' »»»»»»»» ' 03/20/2002 01:45:37 PM - 1.0.0 - TDC ' 1) Initially created ' ' Future considerations: ' »»»»»»»»»»»»»»»»»»»»»» ' 1) None ' ' vbdPowerSet begins here: ' ùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùù
Dim objSelSet As AcadSelectionSet Dim objSelCol As AcadSelectionSets Set objSelCol = ThisDrawing.SelectionSets For Each objSelSet In objSelCol If objSelSet.Name = strName Then objSelCol.Item(strName).Delete Exit For End If Next Set objSelSet = objSelCol.Add(strName) Set vbdPowerSet = objSelSet End Function
And finally, Frank's routine BuildFilter, makes creating selection set filters for VB/VBA much cleaner with a lot less typing:
CODE
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes()) ' ' Title : BuildFilter ' ' Version : ?.?.? ' Author(s) : Frank Oquendo ' Created : 03/20/2002 11:17:43 AM ' Last Edit : 03/20/2002 11:17:43 AM, TDC ' ' Description: ' »»»»»»»»»»»» ' This routine is used to fill a pair of variants ' with arrays for use as a selection set filter. ' ' Additional files/functions required: ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»» ' 1) None ' ' Requires the following variables: ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»» ' * Input assignments ' 1) typeArray - An integer array of DXF codes. ' 2) dataArray - A Variant array of DXF code descriptions. ' ' Example usage: ' »»»»»»»»»»»»»» ' BuildFilter intData, varData, -4, "<and", _ ' 0, "INSERT", _ ' 2, "TB*", _ ' -4, "and>" ' ' Updates: ' »»»»»»»» ' 03/20/2002 11:17:43 AM - 1.0.0 - TDC ' 1) Initially created ' ' Future considerations: ' »»»»»»»»»»»»»»»»»»»»»» ' 1) None ' ' BuildFilter begins here: ' ùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùù
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
So, complex queries like this:
CODE
Dim intData(0 to 8) As Integer Dim varData(0 to 8) As Variant Dim dblPnt(0 to 2) As Double