×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

AutoCAD VB/VBA

Easier selection set creation in VB/VBA. by TCARPENTER
Posted: 4 Apr 05 (Edited 4 Apr 05)

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

Back to Autodesk: AutoCAD FAQ Index
Back to Autodesk: AutoCAD Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close