Public Sub PopulateLegend()
        Dim ed As Editor = DocumentManager.MdiActiveDocument.Editor
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim doc As Document = DocumentManager.MdiActiveDocument

        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 Not 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

                        ids.Add(Blockid)

                        Dim newbref As Autodesk.AutoCAD.DatabaseServices.BlockReference = New Autodesk.AutoCAD.DatabaseServices.BlockReference(tPnt, Blockid)
                        'newbref.ScaleFactors = New Scale3d(1, 1, 1)

                        btr.AppendEntity(newbref)
                        tr.AddNewlyCreatedDBObject(newbref, True)

                    End If
                Next id
            Next btrID

            ' Now for each id as a new block
            For Each blkID As ObjectId In ids
                Dim btr As BlockTableRecord = blkID.GetObject(OpenMode.ForWrite)
                Dim newbref As Autodesk.AutoCAD.DatabaseServices.BlockReference = New Autodesk.AutoCAD.DatabaseServices.BlockReference(tPnt, blkID)
                'newbref.ScaleFactors = New Scale3d(1, 1, 1)

                tPnt = New Point3d(tPnt.X, tPnt.Y - 15, 0.0)
                btr.AppendEntity(newbref)
                tr.AddNewlyCreatedDBObject(newbref, True)
            Next


            tr.Commit()
        End Using
        'End Using
    End Sub ' Populates legend with each modelspace block