OK, here is a somewhat simpler version of the code that uses only a single transaction to insert and configure each block. It makes no sense to wrap the entire outer loop into a single transaction because this test code is only a small part of a much larger application. That app needs to create varying number or x bx x's at various times, including, often, having to add a single instance of the x by x. In addition, I am trying to build a framework that will allow me to manipulate a wide variety of dynamic blocks.
The block that I am using here is particularly simple; it has only height and width properties. Again, in the test code they are all the same, but in the real application they change with almost every instance and so, replacing the x by x with a non-dynamic block does not solve the problem.
The error message that I get is one that I trap for on line 150 in the code; namely that the SetProperty method fails to find the property it is trying to set. If that happened on the first instance of setting a group of properties, the debugging would be trivial. What makes it harder, is that the code successfully sets the properties for several dozen instances of the block reference and then fails. In, fact, it will often successfully set the Height property and then fail on its attempt to set the Width.
' (C) Copyright 2013 by Don Stevens-Rayburn
'
Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
' This line is not mandatory, but improves loading performances
<Assembly: CommandClass(GetType(TestCode.TestClass))>
Namespace TestCode
Public Class TestClass
Private _parentBlockID As ObjectId
Private _parentBlockName As String = "DynamicRectangle"
<CommandMethod("Test")> Public Sub Test()
Dim XbyX As XbyXEndView
Dim point As New Point3d(0, 0, 0)
Dim offset As New Vector3d(2.5, 0, 0)
Dim num As Integer = 1
Try
Do While num <= 1000
AcadEditor.WriteLine("Generating block reference # " & num.ToString)
XbyX = New XbyXEndView
XbyX.Height = 5.5
XbyX.Width = 1.5
Dim acTransaction As Transaction = GetAutocadTransaction()
Using acTransaction
Dim modelSpace As BlockTableRecord
Dim bt As BlockTable = CType(acTransaction.GetObject(Application.DocumentManager.MdiActiveDocument.Database.BlockTableId, OpenMode.ForRead), BlockTable)
modelSpace = CType(acTransaction.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
XbyX.CreateReference(point, modelSpace, acTransaction)
acTransaction.Commit()
End Using
acTransaction.Dispose()
num += 1
point += offset
Loop
Catch ex As Autodesk.AutoCAD.Runtime.Exception
AcadEditor.ReportError(ex)
End Try
End Sub
Public Shared Function GetAutocadTransaction() As Transaction
Threading.Thread.Sleep(0)
Dim tr As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction()
tr.TransactionManager.QueueForGraphicsFlush()
Threading.Thread.Sleep(0)
Return tr
End Function
End Class
Public Class XbyXEndView
Private Shared _parentBlockID As ObjectId = Nothing
Private _parentBlockName As String
Private _acBlockReference As BlockReference = Nothing
Private _layer As String = "<use current>"
Private _rotation As Double
Private _scaleX As Double = 1.0
Private _scaleY As Double = 1.0
Private _scaleZ As Double = 1.0
Public Sub New()
_parentBlockName = "XbyX End View"
If _parentBlockID = Nothing Then
_parentBlockID = GetParentBlockIdFromName(_parentBlockName)
End If
End Sub
Public Property Width As Double = 1.5
Public Property Height As Double = 3.5
' There has to be a better way of doing this...
Protected Function GetParentBlockIdFromName(blockName As String) As ObjectId
Dim blockId As ObjectId = Nothing
Dim acTransaction As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction()
Using acTransaction
Dim blockTable As BlockTable = CType(acTransaction.GetObject(Application.DocumentManager.MdiActiveDocument.Database.BlockTableId, OpenMode.ForRead), BlockTable)
Dim bTIterator As SymbolTableEnumerator = blockTable.GetEnumerator
If blockTable.Has(blockName) Then
Dim moreRecords As Boolean
Dim btr As BlockTableRecord
Dim btrID As ObjectId
bTIterator.Reset()
moreRecords = bTIterator.MoveNext
Dim success As Boolean = False
Do While moreRecords
btrID = bTIterator.Current
btr = CType(acTransaction.GetObject(btrID, OpenMode.ForRead), BlockTableRecord)
If btr.Name = blockName Then
blockId = btr.ObjectId
success = True
Exit Do
End If
moreRecords = bTIterator.MoveNext
Loop
If Not success Then
Throw New System.Exception("Look up failure for block: " & blockName)
End If
Else
Throw New System.Exception("Block" & blockName & " does not exist in the current document...")
End If
acTransaction.Commit()
End Using
Return blockId
End Function
Public Sub CreateReference(Location As Point3d, blockTableRec As BlockTableRecord, acTransaction As Transaction)
If _acBlockReference = Nothing Then
_acBlockReference = New BlockReference(Location, _parentBlockID)
Dim id As ObjectId = blockTableRec.AppendEntity(_acBlockReference)
If _acBlockReference.IsNewObject Then
acTransaction.AddNewlyCreatedDBObject(_acBlockReference, True)
End If
_acBlockReference.ScaleFactors = New Scale3d(_scaleX, _scaleY, _scaleZ)
If _layer <> "<use current>" Then
_acBlockReference.Layer = _layer
End If
_acBlockReference.Rotation = _rotation
SetProperty("Height", Height)
SetProperty("Width", Width)
Else
Throw New System.Exception("Reference already created...")
End If
End Sub
Protected Sub SetProperty(ByVal Name As String, ByVal Value As Double)
If _acBlockReference <> Nothing Then
Threading.Thread.Sleep(0)
Dim success As Boolean = False
Dim propColl As DynamicBlockReferencePropertyCollection = _acBlockReference.DynamicBlockReferencePropertyCollection
Dim prop As DynamicBlockReferenceProperty
For Each prop In propColl
If prop.PropertyName.ToUpper = Name.ToUpper Then
prop.Value = Value
AcadEditor.WriteLine("Successfully set property " & Name & " on block reference: " & _acBlockReference.Name)
success = True
Exit For
End If
Next
If Not success Then
AcadEditor.WriteLine("Failed to set property " & Name & " on block reference: " & _acBlockReference.Name)
Throw New System.Exception(_parentBlockName & " does not have a property " & Name)
End If
Else
Throw New System.Exception(_parentBlockName & " is not a dynamic block.")
End If
End Sub
End Class
Public Class AcadEditor
Public Shared Sub ExecuteCommand(command As String)
Application.DocumentManager.MdiActiveDocument.SendStringToExecute(Chr(27) & Chr(27) & command, True, False, True)
End Sub
Public Shared Sub WriteLine(ByVal message As String)
Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbCrLf & message & vbCrLf)
End Sub
Public Shared Sub ReportError(ByVal ex As System.Exception)
Dim message As String = ex.Message & vbCrLf & vbCrLf & ex.StackTrace
message &= vbCrLf & vbCrLf & ex.Source
If ex.InnerException IsNot Nothing Then
message &= vbCrLf & vbCrLf & ex.InnerException.Message
End If
MsgBox(message, MsgBoxStyle.Critical, "Error")
End Sub
End Class
End Namespace
