Error Aborting AutoCAD

[Prajith76]

Hello,

I produced a dll using VB.NET for praparing the longitudinal profile, it works fine. But when i type the same command second time in the "same" drawing AutoCAD is aborting with a FATAL ERROR as "Unhandled Access Violation Reading 0x0000 Exception at d6e7a26h". Anybody can help me to resolve this issue?

The code is listed as below.

    <CommandMethod("Profile")> _
    Public Sub profile()

        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim prbname As PromptStringOptions = New PromptStringOptions("Enter Block Name: ")
        Dim rsbname As PromptResult
        rsbname = ed.GetString(prbname)

        If Not rsbname.Status = PromptStatus.OK Then Return

        Dim bname As String = rsbname.StringResult

        Using trans As Transaction = db.TransactionManager.StartTransaction

            Dim linetype As LinetypeTable = trans.GetObject(db.LinetypeTableId, OpenMode.ForRead)

            If Not linetype.Has("CENTER") Then
                db.LoadLineTypeFile("CENTER", "acad.lin")
            End If

            If Not linetype.Has("HIDDEN") Then
                db.LoadLineTypeFile("HIDDEN", "acad.lin")
            End If

            If Not linetype.Has("DOT") Then
                db.LoadLineTypeFile("DOT", "acad.lin")
            End If

            If Not db.Ltscale = 10 Then
                db.Ltscale = 10
            End If

            Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)

            If bt.Has(bname) Then
                ed.WriteMessage("Block Name Exists! ")
                trans.Dispose()
                Exit Sub
            Else

                Dim btr As BlockTableRecord = New BlockTableRecord
                Dim bid As ObjectId
                btr.Name = bname

                bid = bt.Add(btr)
                trans.AddNewlyCreatedDBObject(btr, True)

                getexcel() ' subroutines for additional operations

                filldetails() ' subroutines for additional operations

                Dim ts As ObjectId
                ts = createtextstyle("my")

                Dim mht As ObjectId = CreateLayer("mhtxt", 2)
                Dim mha As ObjectId = CreateLayer("mhaxis", 8, "CENTER")
                Dim mh As ObjectId = CreateLayer("mh", 7)
                Dim pi As ObjectId = CreateLayer("pipe", 6)
                Dim tx As ObjectId = CreateLayer("txt", 7)
                Dim dt As ObjectId = CreateLayer("datum", 3)
                Dim dtt As ObjectId = CreateLayer("datumtxt", 2)
                Dim fr As ObjectId = CreateLayer("frame", 2)
                Dim gl As ObjectId = CreateLayer("gl", 3, "HIDDEN")
                Dim gr As ObjectId = CreateLayer("grids", 8, "DOT")
                Dim sr As ObjectId = CreateLayer("services", 1)

                createframe(btr) ' subroutines for additional operations
                addframe(btr) ' subroutines for additional operations
                placetext(btr) ' subroutines for additional operations
                placedatum(btr) ' subroutines for additional operations
                placemh(btr) ' subroutines for additional operations
                placepipe(btr) ' subroutines for additional operations
                createaxis(btr) ' subroutines for additional operations

                If lineref <> "" Then
                    createlineref(btr) ' subroutines for additional operations
                End If

                If chinc <> 0 Then
                    placechainage(btr) ' subroutines for additional operations
                Else
                    MsgBox("Chainage Increment is Missing ....", vbInformation)
                End If

                fillservicedetails() ' subroutines for additional operations
                placedetails(btr) ' subroutines for additional operations

                Dim prpt As PromptPointOptions = New PromptPointOptions("Pick Point to Place" & bname)
                Dim rspt As PromptPointResult
                rspt = ed.GetPoint(prpt)

                'Inserting Block code
                Dim currspace As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                Dim insert As BlockReference = New BlockReference(rspt.Value, bid)
                currspace.AppendEntity(insert)
                trans.AddNewlyCreatedDBObject(insert, True)

                trans.Commit()
                trans.Dispose()
                clearexcel()

            End If

            details = Nothing
            srdetails = Nothing

        End Using
        
    End Sub

[Juergen.Becker]

Don't dispose the Transaction

trans.Commit() this is OK
trans.Dispose() Don't do that

[Prajith76]

Dear Juergen.Becker,

Thank you very much for your response.

Sorry my ignorance. I removed trans.Dispose() but getting the same error.

Is there is any other reason to get this error while using the command second time in same drawing. It is working fine in all drawings for the first time. 

Prajith.

[Juergen.Becker]

Hi,

What about this:

If bt.Has(bname) Then
ed.WriteMessage("Block Name Exists! ")
trans.Dispose()
Exit Sub
Else

it would be a problem when you exit the Sub without a transaction-commit.

Please commit the transaction close to the End Using-Statement.

try this its much clearer.

Using trans As Transaction = db.TransactionManager.StartTransaction

If bt.Has(bname) Then

ed.WriteMessage("Block Name Exists! ")

Else

What you wanna do

End IF

trans.commit()

End Using

Regards Jürgen

[Prajith76]

Hi,

I tried that also but same result is coming out.

Moreover care has been taken while entering the blockname (avoid existing blockname) inorder to excute the ELSE block of IF statement.

Prajith.

[Juergen.Becker]

OK.

Please debug the code step by step and check where the error appears.

You use subroutines within an using-statement, you can do that, but be carefully with the transaction.

btw, it is very important to use the using-Statement correct, don't leave the using-statement without an commitment of the transaction. Don't use Exit Sub or something else.

Regards

[Prajith76]

Hi,

I am getting error when the function"ts = createtextstyle("my")" is called second time. See the attachment as well. I dont understand why the debug point is not reached for the second time when the function is called. First time everything works fine...

code is listed below,

Public Function createtextstyle(ByVal name As String) As ObjectId
        Dim db1 As Database = HostApplicationServices.WorkingDatabase
        Using trans1 As Transaction = db1.TransactionManager.StartTransaction
            Dim lt As TextStyleTable = trans1.GetObject(db1.TextStyleTableId, OpenMode.ForRead)
            Dim textstyleid As New ObjectId
            If lt.Has(name) Then
                textstyleid = lt(name)
                db1.Textstyle = textstyleid
            Else
               Dim tst As New TextStyleTableRecord
                tst.Name = name
                Dim stfont As Autodesk.AutoCAD.GraphicsInterface.FontDescriptor
                stfont = tst.Font
                Dim nfont As Autodesk.AutoCAD.GraphicsInterface.FontDescriptor = New Autodesk.AutoCAD.GraphicsInterface.FontDescriptor("Arial", stfont.Bold, stfont.Italic, stfont.CharacterSet, stfont.PitchAndFamily)
                tst.Font = nfont
                lt.UpgradeOpen()
                textstyleid = lt.Add(tst)
                trans1.AddNewlyCreatedDBObject(tst, True)
                db1.Textstyle = textstyleid
            End If

            trans1.Commit()
            Return textstyleid
            db1.Dispose()
        End Using
    End Function

[Prajith76]

Hi,

I tested the textstyle function several times using the following command and found no problem. But when this function is called in the profile for the second time AutoCAD is aborting with a fatal error. What could be the problem? Any ideas.

<CommandMethod("Newtxtstyle")> _
    Public Sub nstyle()
        Dim ns As ObjectId = createtextstyle(InputBox("Enter Style Name: "))
    End Sub

[Prajith76 · Accepted solution]

Hi guys,

Finally problem has been resolved which was in the code of destroying the collection.

It works fine now by changing the code as below,

 details = Nothing
 srdetails = Nothing

to

 details.Clear()

 srdetails.Clear()

Thanks a lot for your support. Much appreciated.

Prajith.