Inserting block reference which stored in the same drawing / db

[ProfWolfMan]

Hi all,

I am trying to write a function to insert a block reference of a block definition which is already stored in the same drawing.

All threads are leads me to the way of inserting another drawing to current drawing with use of database.readdwgfile & database.insert. 

Kindly share how to use those methods for a block definition stored in the same drawing.

[Anonymous]

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.LayerManager.LayerFilter
Imports Autodesk.AutoCAD.EditorInput
Imports System.IO
Imports Autodesk.AutoCAD.Geometry

Public Class Class1

    ' Define command 'Asdkcmd1'
    <CommandMethod("ImpBloc")> _
    Public Sub ImpBloc()
        'implanter un bloc Bp
        'imp the bloc
        Dim DB As Database = HostApplicationServices.WorkingDatabase
        Dim ed As Editor
        ed = Application.DocumentManager.MdiActiveDocument.Editor

        Dim trans As Transaction
        trans = DB.TransactionManager.StartTransaction

        'récupération de la table des block
        'rep the block def.
        Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)

        Dim btr As BlockTableRecord
        btr = trans.GetObject(bt.Item(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

        Dim id As ObjectId

        If bt.Has("bp") Then
            'found in the  base
            Dim btrSrc As BlockTableRecord
            btrsrc=trans.GetObject(bt.Item("BP"), OpenMode.ForRead)
            id = btrSrc.Id
        Else
            'not found --> load the dwg

            Dim Dbdwg As New Database(False, True)
            Dbdwg.ReadDwgFile("d:\autocad\bloc.dwg\bp.dwg", FileOpenMode.OpenTryForReadShare, True, "")
            id = DB.Insert("bp", Dbdwg, False)
            Dbdwg.Dispose()
        End If
        '

        'insertion :
        Dim opPt As New PromptPointOptions("Sélect a point")
        Dim resPt As PromptPointResult
        resPt = ed.GetPoint(opPt)

        Dim ptInsert As Point3d = Nothing
        Dim blkRef As BlockReference

        If resPt.Status = PromptStatus.OK Then
            ptInsert = resPt.Value

            blkRef = New BlockReference(ptInsert, id)

            btr.AppendEntity(blkRef)
            trans.AddNewlyCreatedDBObject(blkRef, True)

            ' modify the attribute of the block reference
            Dim btAttRec As BlockTableRecord
            btAttRec = trans.GetObject(id, OpenMode.ForRead)
            Dim idAtt As ObjectId
            For Each idAtt In btAttRec
                Dim ent As Entity
                ent = trans.GetObject(idAtt, OpenMode.ForRead)
                If TypeOf ent Is AttributeDefinition Then
                    Dim attDef As AttributeDefinition
                    attDef = CType(ent, AttributeDefinition)
                    Dim attRef As New AttributeReference()
                    attRef.SetAttributeFromBlock(attDef, blkRef.BlockTransform)
                    'Dim ptBase As New Point3d(blkRef.Position.X + attDef.Position.X, blkRef.Position.Y + attDef.Position.Y, blkRef.Position.Z + attDef.Position.Z)
                    'attRef.Position = ptBase
                    'attRef.Rotation = attDef.Rotation
                    'attRef.Tag = attDef.Tag
                    attRef.TextString = "input your data here"
                    'attRef.Height = attDef.Height
                    'attRef.FieldLength = attDef.FieldLength
                    Dim idTmp As ObjectId
                    idTmp = blkRef.AttributeCollection.AppendAttribute(attRef)
                    trans.AddNewlyCreatedDBObject(attRef, True)

                End If
            Next
            trans.Commit()

        Else
            MsgBox("Point introuvable !")
            trans.Abort()
        End If


       
    End Sub
end class

 here a example for insert a block and fill the attribut

if the block is know in the base --> insert but if not the vb.net load a file bp.dwg

[Hallex · Accepted solution]

Try this code for the same drawing

    Public Sub ApplyAttributes(db As Database, tr As Transaction, bref As BlockReference)

        Dim btrec As BlockTableRecord = TryCast(tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)

        If btrec.HasAttributeDefinitions Then

            Dim atcoll As Autodesk.AutoCAD.DatabaseServices.AttributeCollection = bref.AttributeCollection

            For Each subid As ObjectId In btrec

                Dim ent As Entity = DirectCast(subid.GetObject(OpenMode.ForRead), Entity)

                Dim attDef As AttributeDefinition = TryCast(ent, AttributeDefinition)

                If attDef IsNot Nothing Then

                    Dim attRef As New AttributeReference()

                    attRef.SetDatabaseDefaults()

                    attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)

                    attRef.Position = attDef.Position.TransformBy(bref.BlockTransform)

                    attRef.Tag = attDef.Tag

                    attRef.TextString = attDef.TextString

                    attRef.AdjustAlignment(db)

                    atcoll.AppendAttribute(attRef)

                    tr.AddNewlyCreatedDBObject(attRef, True)

                End If

            Next
        End If
    End Sub

    Public Sub TestInsert()
        Dim blkname As String = "MYBLOCK" ''<-- change to your needs
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim db As Database = doc.Database
        Try
            Using docloc As DocumentLock = doc.LockDocument

                Using tr As Transaction = db.TransactionManager.StartTransaction
                    Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)

                    If Not bt.Has(blkname) Then
                        MsgBox("Block does not exists")
                        Return
                    End If

                    Dim pto As PromptPointOptions = New PromptPointOptions(vbLf + "Pick a block insertion point: ")
                    Dim ptres As PromptPointResult = ed.GetPoint(pto)
                    Dim ipt As Point3d

                    If ptres.Status <> PromptStatus.Cancel Then
                        ipt = ptres.Value
                    End If

                    Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord)
                    Dim blk As BlockTableRecord = DirectCast(tr.GetObject(bt(blkname), OpenMode.ForRead, False), BlockTableRecord)
                    Dim bref As New BlockReference(ipt, blk.ObjectId)
                    bref.BlockUnit = UnitsValue.Millimeters''<-- change to your needs
                    bref.Rotation = 0
                    bref.ScaleFactors = New Scale3d(1.0) ''<-- change to your needs
                    btr.AppendEntity(bref)
                    tr.AddNewlyCreatedDBObject(bref, True)
                    ApplyAttributes(db, tr, bref)
                    ed.Regen()
                    tr.Commit()
                End Using
            End Using
        Catch ex As System.Exception
            MsgBox(ex.Message)
        End Try
    End Sub

~'J'~

[ProfWolfMan]

Both answers my question. Thank you very much for your valuable time spend on this.

Now slowly i am learning dotnet .While i need one clarification on Hallex code.

Why you use "Directcast" on below lines?. If the question make any sense kindly answer.

 Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord)
                    Dim blk As BlockTableRecord = DirectCast(tr.GetObject(bt(blkname), OpenMode.ForRead, False), BlockTableRecord)

[Hallex]

Here is an excerpt from MSDN docs:Remarks

DirectCast does not use the Visual Basic run-time helper routines for conversion, so it can provide somewhat better performance than CType when converting to and from data type Object.

You use the DirectCast keyword similar to the way you use the CType Function (Visual Basic) and the TryCast Operator (Visual Basic) keyword. You supply an expression as the first argument and a type to convert it to as the second argument. DirectCast requires an inheritance or implementation relationship between the data types of the two arguments. This means that one type must inherit from or implement the other.

Errors and Failures

DirectCast generates a compiler error if it detects that no inheritance or implementation relationship exists. But the lack of a compiler error does not guarantee a successful conversion. If the desired conversion is narrowing, it could fail at run time. If this happens, the runtime throws an InvalidCastException error.

Hope it make a sense,

Cheers 🙂

~'J'~

[ProfWolfMan]

Today i learned some more things.

Thank you very much for your reply.

[Hallex]

Glad I could help,

Happy coding 🙂

~'J'~