Here is Kean's source code (C#), converted to VB using the site linked above *untested*
Code:
'
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports System.Collections.Generic
Namespace EntitySelection
Public Class Commands
<CommandMethod("SDB")> _
Public Shared Sub SelectDynamicBlocks()
Dim doc = Application.DocumentManager.MdiActiveDocument
Dim ed = doc.Editor
Dim pso = New PromptStringOptions(vbLf & "Name of dynamic block to search for")
pso.AllowSpaces = True
Dim pr = ed.GetString(pso)
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim blkName As String = pr.StringResult
Dim blkNames As New List(Of String)()
blkNames.Add(blkName)
Dim tr = doc.TransactionManager.StartTransaction()
Using tr
Dim bt = DirectCast(tr.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
' Start by getting the handle of our block, if it exists
If Not bt.Has(blkName) Then
ed.WriteMessage(vbLf & "Cannot find block called ""{0}"".", blkName)
Return
End If
Dim btr = DirectCast(tr.GetObject(bt(blkName), OpenMode.ForRead), BlockTableRecord)
Dim blkHand = btr.Handle
For Each bid As var In bt
' We'll check each block in turn, to see if it has
' XData pointing to our original block definition
Dim btr2 = DirectCast(tr.GetObject(bid, OpenMode.ForRead), BlockTableRecord)
' Only check blocks that don't share the name :-)
If btr2.Name <> blkName Then
' And only check blocks with XData
Dim xdata = btr2.XData
If xdata IsNot Nothing Then
' Get the XData as an array of TypeValues and loop
' through it
Dim tvs As TypedValue() = xdata.AsArray()
For i As Integer = 0 To tvs.Length - 1
' The first value should be the RegAppName
Dim tv = tvs(i)
If tv.TypeCode = CInt(DxfCode.ExtendedDataRegAppName) Then
' If it's the one we care about...
If DirectCast(tv.Value, String) = "AcDbBlockRepBTag" Then
' ... then loop through until we find a
' handle matching our blocks or otherwise
' another RegAppName
For j As Integer = i + 1 To tvs.Length - 1
tv = tvs(j)
If tv.TypeCode = CInt(DxfCode.ExtendedDataRegAppName) Then
' If we have another RegAppName, then
' we'll break out of this for loop and
' let the outer loop have a chance to
' process this section
i = j - 1
Exit For
End If
If tv.TypeCode = CInt(DxfCode.ExtendedDataHandle) Then
' If we have a matching handle...
If DirectCast(tv.Value, String) = blkHand.ToString() Then
' ... then we can add the block's name
' to the list and break from both loops
' (which we do by setting the outer index
' to the end)
blkNames.Add(btr2.Name)
i = tvs.Length - 1
Exit For
End If
End If
Next
End If
End If
Next
End If
End If
Next
tr.Commit()
End Using
' Build a conditional filter list so that only
' entities with the specified properties are
' selected
Dim sf As New SelectionFilter(CreateFilterListForBlocks(blkNames))
Dim psr As PromptSelectionResult = ed.SelectAll(sf)
ed.WriteMessage(vbLf & "Found {0} entit{1}.", psr.Value.Count, (If(psr.Value.Count = 1, "y", "ies")))
End Sub
Private Shared Function CreateFilterListForBlocks(blkNames As List(Of String)) As TypedValue()
' If we don't have any block names, return null
If blkNames.Count = 0 Then
Return Nothing
End If
' If we only have one, return an array of a single value
If blkNames.Count = 1 Then
Return New TypedValue() {New TypedValue(CInt(DxfCode.BlockName), blkNames(0))}
End If
' We have more than one block names to search for...
' Create a list big enough for our block names plus
' the containing "or" operators
Dim tvl As New List(Of TypedValue)(blkNames.Count + 2)
' Add the initial operator
tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "<or"))
' Add an entry for each block name, prefixing the
' anonymous block names with a reverse apostrophe
For Each blkName As var In blkNames
tvl.Add(New TypedValue(CInt(DxfCode.BlockName), (If(blkName.StartsWith("*"), "`" & blkName, blkName))))
Next
' Add the final operator
tvl.Add(New TypedValue(CInt(DxfCode.[Operator]), "or>"))
' Return an array from the list
Return tvl.ToArray()
End Function
End Class
End Namespace
Filtering for Dynamic Blocks using XData - Need help with XData.ASArray
Reply With Quote
Originally Posted by apitcher799568
