PDA

View Full Version : Filtering for Dynamic Blocks using XData - Need help with XData.ASArray



apitcher799568
2015-08-28, 01:25 PM
I am trying to filter for a dynamic block using xdata. I found this post (http://through-the-interface.typepad.com/through_the_interface/2012/09/creating-a-selection-filter-that-finds-dynamic-blocks-in-autocad-using-net.html) by Kean Walmsley going over the process, but I haven't been able to make it work for me. The code he has is in C#, which I'm not familiar with (I code very rarely).

This is what I have so far:



Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor


Using tr As Transaction = doc.TransactionManager.StartTransaction()

Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForWrite)

For Each bid In bt
Dim btr2 As BlockTableRecord = tr.GetObject(bid, OpenMode.ForWrite)
If Not btr2.Name = "PointMarker" AndAlso IsDBNull(btr2.XData) = False Then
Dim TypeValArr() As TypedValue = btr2.XData.AsArray
For i = 0 To TypeValArr.Length
Dim TypeVal As String = TypeValArr(i)
If TypeVal.GetTypeCode = DxfCode.ExtendedDataRegAppName Then
If TypeVal.ToString = "AcDbBlockRepBTag" Then
For j = i + 1 To TypeValArr.Length
TypeVal = TypeValArr(j)
If TypeVal.GetTypeCode = DxfCode.ExtendedDataRegAppName Then
i = j - 1
Exit For
End If
If TypeVal.GetTypeCode = DxfCode.ExtendedDataHandle Then
If TypeVal.ToString = "PointMarker" Then
Dim blockref As BlockReference = btr2.Id.GetObject(OpenMode.ForWrite)
Dim xpos As Double = blockref.Position.X
Dim ypos As Double = blockref.Position.Y
Dim zpos As Double = blockref.Position.Z
Dim scalefactor As Double = blockref.ScaleFactors.X
blockref.ScaleFactors() = New Scale3d(sf)
Dim ac As AttributeCollection = blockref.AttributeCollection
For Each att As ObjectId In ac
Dim attr As DBObject = att.GetObject(OpenMode.ForWrite)
If TypeOf attr Is AttributeReference Then
Dim ar As AttributeReference = att.GetObject(OpenMode.ForWrite)
ar.TransformBy(Matrix3d.Scaling(1 / scalefactor, New Point3d(xpos, ypos, zpos)))
ar.TransformBy(Matrix3d.Scaling(sf, New Point3d(xpos, ypos, zpos)))
End If
Next
i = TypeValArr.Length - 1
Exit For
End If
End If
j = j + 1
Next
End If
End If
i = i + 1
Next

End If
Next

tr.Commit()

End Using




I am stuck on the "Dim TypeValArr As Array = btr2.XData.AsArray" part. It continually causes a fatal error when the code runs. Should I be declaring this differently?

BlackBox
2015-08-28, 03:39 PM
Firstly, you may find this site (http://www.developerfusion.com/tools/convert/csharp-to-vb/) useful for converting between C# and VB.NET.

That said, you'll have a much easier time learning from others' examples, source code, etc. if you start learning C# - there's just way more available than for VB - and I say that speaking from experience, as I too started learning VB.NET (stepping up from LISP), ultimately making the decision to switch to C#, and haven't looked back since. :beer:



In Kean's article, btr2.XData is declared as var, which is just a generic container for the TypedValue[] returned by the XData Property.

So this in C#:


var tvs = xdata.AsArray();


... Is this in VB:


Dim tvs = xdata.AsArray()


... Whereas declaring the actual Type in C#:


TypedValue[] tvs = xdata.AsArray();


... Is this in VB:


Dim tvs As TypedValue() = xdata.AsArray()

BlackBox
2015-08-28, 03:43 PM
Here is Kean's source code (C#), converted to VB using the site linked above *untested*



'
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

apitcher799568
2015-08-28, 04:17 PM
I copied and pasted that, and it worked great. Now I'll have to go through and figure out what I was doing wrong. Thanks a bunch!

BlackBox
2015-08-28, 05:11 PM
I copied and pasted that, and it worked great. Now I'll have to go through and figure out what I was doing wrong. Thanks a bunch!

Happy to help; Cheers :beer:

apitcher799568
2015-08-31, 01:26 PM
I think the difference is that I was not using DirectCast. Can you tell me what its purpose is and when I should be using it?

BlackBox
2015-08-31, 04:05 PM
I think the difference is that I was not using DirectCast. Can you tell me what its purpose is and when I should be using it?

When you TryCast or cast 'as' a given DBObject as something, you can subsequently check for Null (Nothing) before continuing your code... This is useful when iterating an entire Database, or Selection Set of multiple Types (i.e., Circle, Polyline, etc.) to conditionally test for the appropriate DBObject.

I only DirectCast when I've previously implemented sufficient code logic such that I already know the DBObject is of a given Type - for example, if I make a Selection Set of all Circles, then I can trust that a DirectCast to Circle will be successful.