Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
<Assembly: CommandClass(GetType(test1.MyCommands))>
Namespace test1
Public Class MyCommands
#Region "commands"
<CommandMethod("INSERTDYNAMICBLOCK")>
Public Shared Sub insertBlock()
Dim attList As New List(Of String)
Dim name As String = "RMNUM"
Dim db As Database = HostApplicationServices.WorkingDatabase()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.GetDocument(db)
Dim ed As Editor = doc.Editor
Using trans As Transaction = db.TransactionManager.StartTransaction()
' what is this for?
'doc.TransactionManager.EnableGraphicsFlush(True)
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
'what is this for?
'Dim occ As ObjectContextCollection = db.ObjectContextManager.GetContextCollection("ACDB_ANNOTATIONSCALES")
Dim blockDef As BlockTableRecord = trans.GetObject(bt(name), OpenMode.ForRead)
'if bt.has...then
Using acNewBlockRef As New BlockReference(New Point3d, blockDef.ObjectId)
btr.AppendEntity(acNewBlockRef)
trans.AddNewlyCreatedDBObject(acNewBlockRef, True)
'attributes
'classic attrib must always have tag, but tag can be the same
'dynamic prop name must be different
'HERE: BLOCK ATTRIBUTES ARE NOT TRANSFORMED WHEN CHANGING DP (or am I missing something simple somewhere)
If acNewBlockRef.IsDynamicBlock Then
For Each dp As DynamicBlockReferenceProperty In acNewBlockRef.DynamicBlockReferencePropertyCollection
If Not dp.ReadOnly Then
'now, IF we change dynprop (flip), then attrib is no longer at proper place without attsync
Dim dpnameToSearch As String = "Flip state1"
Dim newVal As Double = 1.0
Select Case dp.PropertyTypeCode
Case 1
dp.Value = newVal
Case 2
dp.Value = Convert.ToInt32(newVal Mod Int32.MaxValue)
Case 3
dp.Value = Convert.ToInt16(newVal Mod Int16.MaxValue)
Case 4
dp.Value = Convert.ToSByte(newVal Mod Byte.MaxValue)
Case 5
dp.Value = Convert.ToString(newVal)
Case 13
dp.Value = Convert.ToInt64(newVal Mod Int64.MaxValue)
Case Else
End Select
End If
Next
End If
For Each attId As ObjectId In blockDef
Dim ent As Entity = trans.GetObject(attId, OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
If (attDef IsNot Nothing) AndAlso (Not attDef.Constant) Then
'This is a non-constant AttributeDefinition
Using attRef As New AttributeReference()
attRef.SetAttributeFromBlock(attDef, acNewBlockRef.BlockTransform)
acNewBlockRef.AttributeCollection.AppendAttribute(attRef)
trans.AddNewlyCreatedDBObject(attRef, True)
'CHECK HERE FOR THIS ATTRIB
attRef.TextString = "test"
If attRef.HasFields Then
Dim fOif As ObjectId = attRef.GetField()
Dim fo As Field = trans.GetObject(fOif, OpenMode.ForWrite)
fo.Evaluate()
End If
End Using
End If
End If
Next
'what is this for?
'acNewBlockRef.RecordGraphicsModified(True) ' to force updating a block reference
End Using
'what is this for?
'trans.TransactionManager.QueueForGraphicsFlush()
trans.Commit()
End Using
End Sub
<CommandMethod("GETBLOCKATT")>
Public Shared Sub getBlockAttributesByBlockName(g)
Dim name As String = "RMNUM"
Dim realName As String = ""
realName = name
Dim attList As New List(Of String)
Dim db As Database = HostApplicationServices.WorkingDatabase()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.GetDocument(db)
Dim ed As Editor = doc.Editor
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
If bt.Has(name) Then
Dim blockDef As BlockTableRecord = trans.GetObject(bt(name), OpenMode.ForRead)
realName = blockDef.Name
If blockDef.HasAttributeDefinitions Then
For Each chkObjID As ObjectId In blockDef
Dim ent As Entity = trans.GetObject(chkObjID, OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
attList.Add(attDef.Tag)
End If
Next
End If
If blockDef.IsDynamicBlock Then
'HERE: CRASH IN 50% TIMES
'create new temp ref since i do now know how to get all dynprops
'here, something is wrong. could be that there are more anonymous block created and they are not deleted with dispose
'how to fix this? Or, how to find dynprop withot creating new ref?
Dim tempDynBlockRef As New BlockReference(New Point3d, blockDef.ObjectId)
For Each dp As DynamicBlockReferenceProperty In tempDynBlockRef.DynamicBlockReferencePropertyCollection
If Not dp.ReadOnly Then attList.Add(dp.PropertyName)
Next
tempDynBlockRef.Dispose()
End If
End If
trans.Commit()
End Using
'result is:
'realname with real name of block
'attlist with att tag and dynprop names
End Sub
End Class
End Namespace