Well thanks to fro2001 I got a working sub that places a block, fills attributes and manages the annotative scale!
It is weird that if I turn it into a function, it does do nothing, if I call the procedure, it does work!
Final code:
' This procedure will insert a block into the current drawing. It also controls the defined attributes and it will
' add the current Annotation Scale if the block is Annotative.
' Code contribution:
' - fro2001 - via TheSwamp.org
Public Sub hzInsertBlockMSWithAttributes(ByVal pntInsert As Geometry.Point3d,
ByVal strBlockName As String,
ByVal dScale As Double,
ByVal strLayerName As String,
ByVal arrAttrValues As ArrayList)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim bt As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
Dim btrMS As BlockTableRecord = bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead)
If Not bt.Has(strBlockName) Then
Exit Sub
Else
btrMS.UpgradeOpen()
End If
Dim btr As BlockTableRecord = bt(strBlockName).GetObject(OpenMode.ForRead)
Dim bref As New BlockReference(pntInsert, btr.ObjectId)
btrMS.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
' set annotation scale if block is annotative
If btr.Annotative = AnnotativeStates.True Then
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
Internal.ObjectContexts.AddContext(bref, occ.CurrentContext)
End If
' set attributes and values
' TODO: Set attribute to layer of block or layer of original definition, now it will be placed on layer 0
' TODO: Check if attribute is annotative, it is possible to create non-annotative blocks with annotative attributes
Dim ccAttCounter As Integer = 0
For Each objId As ObjectId In btr
Dim ent As Entity = objId.GetObject(OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
ent.UpgradeOpen()
Dim attDef As AttributeDefinition = CType(ent, AttributeDefinition)
Dim attRef As New AttributeReference
attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
' check if there is a value to add
If arrAttrValues.Count - 1 >= ccAttCounter Then
attRef.TextString = arrAttrValues(ccAttCounter).ToString.Trim
Else
attRef.TextString = ""
End If
bref.AttributeCollection.AppendAttribute(attRef)
tr.AddNewlyCreatedDBObject(attRef, True)
ccAttCounter += 1
End If
Next
' set layer
' TODO: Check if layername exist
bref.Layer = strLayerName
' commit
tr.Commit()
End Using
End Sub
Now I can move on with the tool I am developing, a global import routine from Excel (or basically any delimetered data from the Clipboard). It will place the data in colums (no matter how many) in a datagrid, then you choose the X and Y and Point ID, check the layer and if other data has to be placed as text, and then all the data will be exported as blocks or text.
See screenshot.