Public Sub PopulateLegend()
        Dim ed As Editor = DocumentManager.MdiActiveDocument.Editor
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim doc As Document = DocumentManager.MdiActiveDocument
        Dim dict As New Dictionary(Of ObjectId, String) ' dictionary holding objectId and strings of each block
        Dim ids As New ObjectIdCollection()

        'Using docloc As DocumentLock = doc.LockDocument

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

            'Get Insert Point
            Dim tPnt As Point3d = doc.Editor.GetPoint("Select Text Insert Point: ").Value

            Dim bt As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
            For Each btrID As ObjectId In bt
                Dim btr As BlockTableRecord = btrID.GetObject(OpenMode.ForWrite)

                'If btr.IsLayout Then 'ignore layouts
                '    Return
                'End If

                ' Populate ids objectid collection
                For Each id As ObjectId In btr
                    Dim obj As Autodesk.AutoCAD.DatabaseServices.DBObject = id.GetObject(OpenMode.ForWrite)
                    ' If the object is a block reference
                    If TypeOf obj Is Autodesk.AutoCAD.DatabaseServices.BlockReference Then
                        Dim bref As Autodesk.AutoCAD.DatabaseServices.BlockReference = DirectCast(obj, Autodesk.AutoCAD.DatabaseServices.BlockReference)
                        Dim bName As String = bref.BlockName

                        ed.WriteMessage(bName)

                        Dim Blockid As ObjectId = bt(bName)

                        'If Blockid.IsErased Or Not Blockid.IsValid Then
                        '    ed.WriteMessage(vbNewLine & "Block is not valid or erased")
                        '    Return
                        'End If
                        dict.Add(Blockid, bName)
                        ' ids.Add(Blockid)

                    End If
                Next id
            Next btrID

            ' Now for each id as a new block
            For Each kvp As KeyValuePair(Of ObjectId, String) In dict
                ModelSpaceInsertBlock(tPnt, kvp.Value, 1, 1, 1)
                tPnt = New Point3d(tPnt.X, tPnt.Y - 15, 0.0)
            Next

            tr.Commit()
        End Using
        'End Using
    End Sub ' Populates legend with each modelspace block
    Public Sub ModelSpaceInsertBlock(ByVal InsPt As Point3d, ByVal BlockName As String, ByVal XScale As Double, _
  ByVal YScale As Double, ByVal ZScale As Double)
        Dim myBlkID As ObjectId = ObjectId.Null
        Try

            Dim myDwg As Document = DocumentManager.MdiActiveDocument
            Using myTrans As Transaction = myDwg.TransactionManager.StartTransaction

                'Open the database for Write
                Dim myBT As BlockTable = myDwg.Database.BlockTableId.GetObject(OpenMode.ForRead)
                Dim myModelSpace As BlockTableRecord = myBT(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite)

                'Insert the Block
                Dim myBlockDef As BlockTableRecord = myBT(BlockName).GetObject(OpenMode.ForRead)
                Dim myBlockRef As New Autodesk.AutoCAD.DatabaseServices.BlockReference(InsPt, myBT(BlockName))
                myBlockRef.ScaleFactors = New Scale3d(XScale, YScale, ZScale)

                myModelSpace.AppendEntity(myBlockRef)
                myTrans.AddNewlyCreatedDBObject(myBlockRef, True)
                myBlkID = myBlockRef.ObjectId

                'Append Attribute References to the BlockReference
                Dim myAttColl As AttributeCollection
                Dim myEntID As ObjectId
                Dim myEnt As Autodesk.AutoCAD.DatabaseServices.Entity
                myAttColl = myBlockRef.AttributeCollection
                For Each myEntID In myBlockDef
                    myEnt = myEntID.GetObject(OpenMode.ForWrite)
                    If TypeOf myEnt Is AttributeDefinition Then
                        Dim myAttDef As AttributeDefinition = CType(myEnt, AttributeDefinition)
                        Dim myAttRef As New AttributeReference
                        myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
                        myAttColl.AppendAttribute(myAttRef)
                        myTrans.AddNewlyCreatedDBObject(myAttRef, True)
                    End If
                Next

                'Commit the Transaction
                myTrans.Commit()
            End Using
        Catch ex As System.Exception
            myBlkID = ObjectId.Null
        End Try

    End Sub 'Receives block id then inserts at point