Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Easier selection set creation in VB/VBA.

AutoCAD VB/VBA

Easier selection set creation in VB/VBA.

by  TCARPENTER  Posted    (Edited  )
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

  intData(0) = 0 : varData(0) = "INSERT"
  intData(1) = -4 : varData(1) = "<or"
  intData(2) = 70 : varData(2) = 0
  intData(3) = 70 : varData(3) = 2
  intData(4) = -4 : varData(4) = "<and"
  intData(5) = 2 : varData(5) = "`*U#*"
  intData(6) = -4 : varData(6) = "*,*,<>"
  intData(7) = 10 : varData(7) = dblPnt
  intData(8) = -4 : varData(8) = "and>"
  intData(9) = -4 : varData(9) "or>"

  ' Ensure a selection set is not already in memory.
  '
  Set ssTitleBlock = vbdPowerSet("SSET_BLOCKS")
  
  ' Build the selection set.
  '
  ssTitleBlock.Select Mode:=acSelectionSetAll, FilterType:=intData, 

FilterData:=varData
  
  ' Was anything actually found?
  '
  If ssBlock.Count = 0 Then
  ...
  ..


Become:

Code: 
  Dim intData() As Integer
  Dim varData() As Variant
  Dim dblPnt(0 to 2) As Double

  BuildFilter intData, varData, 0, "INSERT", _
                               -4, "<or", _
                                 70, 0, _
                                 70, 2, _
                                 -4, "<and", _
                                    2, "`*U#*", _
                                   -4, "*,*,<>", _
                                     10, dblPnt, _
                                 -4, "and>", _
                               -4, "or>"
  
  ' Ensure a selection set is not already in memory.
  '
  Set ssTitleBlock = vbdPowerSet("SSET_BLOCKS")
  
  ' Build the selection set.
  '
  ssTitleBlock.Select Mode:=acSelectionSetAll, FilterType:=intData, 

FilterData:=varData
  
  ' Was anything actually found?
  '
  If ssBlock.Count = 0 Then
  ...
  ..

Making, in my opinion, a much more readable DXF code listing.

HTH
Todd
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top