Topic: Problem with function to add annotative blocks

[Jeff H]

For filling the attributes I have a different function

That is where problem might be

[huiz]

That is where problem might be

I'm not sure. The attributes are defined in my function, in a second one they are filled with text (just a loop, add textstring, nothing special). So the attribute gets defined at original size (I mean the designed size in the block definition with size 1 and Annotation Scale 1:1), even while the block gets an annotative scale. I've tested it also with a scalefactor, the block is scaled with a schale factor and the annotation scale, the attribute still gets the original size. I also tested with adding an empty textstring to the attribute but that doesn't do the trick.

Further I'm very confused why I don't get any attribute if I replace the part where I use Enumerator by your code with Foreach, but if I test your Sub without modification (and thus the same code to add attributes), I do get attributes and they nicely get scaled!

[Jeff H]

          For Each objId As ObjectId In myBTR

Change to
For Each objId As ObjectId In myBlockDef

[Jeff H]

Did you define the block in a drawing with same settings as the Test.dwg you posted because your units are set to meters so 1:1 is 1 paper unit is equal to .001 drawing units

[huiz]

Did you define the block in a drawing with same settings as the Test.dwg you posted because your units are set to meters so 1:1 is 1 paper unit is equal to .001 drawing units

Sorry, I mean Annotation Scale 1:1000 (1 paper unit is 1 model unit). We use meters as standard.

Tomorrow I'll continue with my search. Probably something very simple so fix...

[Jeff H]

You were searching through modelspace with the previous code or current space

[huiz]

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:

Code: [Select]

  ' 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.