Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Create Block With Polyline and Attribute - Worked in AutoCad, not BricsCAD - Answered

Ok, I have a sub that creates a block that consists of a polyline and an attribute. It worked just fine in AutoCAD, but not in BricsCAD.

I have made some changes to get it to work with BricsCAD, but it still doesn't work.

It stops at the line: deltaBTR.AppendEntity(deltaPoly)

Imports System.Text
Imports System.Runtime.InteropServices
Imports System.IO
Imports Teigha.Runtime
Imports Teigha.DatabaseServices
Imports Teigha.Geometry
Imports Bricscad.ApplicationServices
Imports Bricscad.Runtime
Imports Bricscad.EditorInput
Imports _AcRx = Teigha.Runtime
Imports _AcAp = Bricscad.ApplicationServices

Public Sub CreateDeltaNoteBlock(ByVal dwg_scale As Double)
    Try
        Dim podDWG As Document = Application.DocumentManager.MdiActiveDocument
        Dim podDB As Database = podDWG.Database
        Using deltaTrans As Transaction = podDB.TransactionManager.StartTransaction
            Dim deltaBTR As BlockTableRecord = New BlockTableRecord With {
                .Name = "Delta_Note"
            }

            ' Add a polyline and attribute to the Block
            Dim centerPoint As Point2d = New Point2d(0, 0)
            Dim distFromCenter As Double = 4.944
            Dim delta_pt1 As Point2d = PolarPoints2D(centerPoint, degreesToRadians(201.0), (distFromCenter * dwg_scale))
            Dim delta_pt2 As Point2d = PolarPoints2D(centerPoint, degreesToRadians(219.0), (distFromCenter * dwg_scale))
            Dim delta_pt3 As Point2d = PolarPoints2D(centerPoint, degreesToRadians(321.0), (distFromCenter * dwg_scale))
            Dim delta_pt4 As Point2d = PolarPoints2D(centerPoint, degreesToRadians(339.0), (distFromCenter * dwg_scale))
            Dim delta_pt5 As Point2d = PolarPoints2D(centerPoint, degreesToRadians(81.0), (distFromCenter * dwg_scale))
            Dim delta_pt6 As Point2d = PolarPoints2D(centerPoint, degreesToRadians(99.0), (distFromCenter * dwg_scale))

            ' Create the polyline
            Dim deltaPoly As Polyline = New Polyline()
            deltaPoly.SetDatabaseDefaults()
            deltaPoly.AddVertexAt(0, delta_pt1, 0, 0, 0)
            deltaPoly.AddVertexAt(1, delta_pt2, 0, 0, 0)
            deltaPoly.AddVertexAt(2, delta_pt3, 0, 0, 0)
            deltaPoly.AddVertexAt(3, delta_pt4, 0, 0, 0)
            deltaPoly.AddVertexAt(4, delta_pt5, 0, 0, 0)
            deltaPoly.AddVertexAt(5, delta_pt6, 0, 0, 0)
            deltaPoly.Closed = True
            ' Add the new object to the block table record and the transaction
            deltaBTR.AppendEntity(deltaPoly)          '<--------Stops here --------

            'Sets the bulge at index 0, 2, and 4
            deltaPoly.SetBulgeAt(0, (Math.Tan((120 / 4) * (Math.PI / 180))))
            deltaPoly.SetBulgeAt(2, (Math.Tan((120 / 4) * (Math.PI / 180))))
            deltaPoly.SetBulgeAt(4, (Math.Tan((120 / 4) * (Math.PI / 180))))

            ' Add an attribute definition to the block
            Using deltaAttDef As New AttributeDefinition
                deltaAttDef.Position = New Point3d(0, 0, 0)
                deltaAttDef.Prompt = "Enter Delta Number: "
                deltaAttDef.Tag = "DeltaNote"
                deltaAttDef.Justify = AttachmentPoint.MiddleCenter
                deltaBTR.AppendEntity(deltaAttDef)

                'deltaBT.UpgradeOpen()
                'deltaBT.Add(deltaBTR)
                deltaBTR.AppendEntity(deltaAttDef)
            End Using

            Dim deltaBT As BlockTable = DirectCast(deltaTrans.GetObject(podDB.BlockTableId, OpenMode.ForWrite), BlockTable)
            deltaBT.Add(deltaBTR)
            'Dim deltaBT As BlockTable = podDWG.Database.BlockTableId.GetObject(OpenMode.ForWrite)
            'Commit the Transaction
            deltaTrans.AddNewlyCreatedDBObject(deltaBTR, True)
            deltaTrans.Commit()

            'Dispose of the Transaction Objects
            deltaTrans.Dispose()
        End Using
    Catch ex As Exception
        MsgBox(ex.ToString, MsgBoxStyle.Information)
    End Try
End Sub

I would really appreciate some help on this, thanks.

Answers

  • edited August 2020

    This seems to have fixed it:

        Dim podDWG As Document = Application.DocumentManager.MdiActiveDocument
        Dim podDB As Database = podDWG.Database
    
        Using deltaTrans As Transaction = podDB.TransactionManager.StartTransaction
            Try
                Dim deltaBT As BlockTable = DirectCast(deltaTrans.GetObject(podDB.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim deltaBTR As BlockTableRecord = deltaTrans.GetObject(deltaBT(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                deltaBTR.Name = "Delta_Note"
    :
    :
    :
    ' Add an attribute definition to the block
    Using deltaAttDef As New AttributeDefinition
                    deltaAttDef.Position = New Point3d(0, 0, 0)
                    deltaAttDef.Prompt = "Enter Delta Number: "
                    deltaAttDef.Tag = "DeltaNote"
                    deltaAttDef.Justify = AttachmentPoint.MiddleCenter
                    deltaBTR.AppendEntity(deltaAttDef)
                    deltaBT.UpgradeOpen()
    End Using
    deltaBT.Add(deltaBTR)
    
                'Commit the Transaction
                deltaTrans.AddNewlyCreatedDBObject(deltaBTR, True)
                deltaTrans.Commit()
    
Sign In or Register to comment.
Origami
Origami is the Japanese word for paper folding. ORI means to fold and KAMI means paper and involves the creation of paper forms usually entirely by folding.

Powered by VanillaForums, Designed by Steam