vbnet cad内存增加到崩溃，高手帮忙看看！

Dim doc As Document = Autodesk..ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor        '在交点周围选着点
        Dim i As Integer = 0
        For i = 0 To IDian_Num
            Dim IPinFenNum As Integer = 8
            For j As Integer = 0 To IPinFenNum - 1
                Dim acPoint3d As Point3d = New Point3d(IntersectPointX(i) + 2 * System.Math.Cos(j * 3.14 * 2 / IPinFenNum), IntersectPointY(i) + 2 * System.Math.Cos(j * 3.14 * 2 / IPinFenNum), 0)
                Dim Pt3dCOLL As New Point3dCollection
                Dim Ldis As Double = 20
                Dim acPoint3d1 As Point3d = New Point3d(acPoint3d.X - Ldis, acPoint3d.Y + Ldis, 0)
                Dim acPoint3d2 As Point3d = New Point3d(acPoint3d.X + Ldis, acPoint3d.Y + Ldis, 0)
                Dim acPoint3d3 As Point3d = New Point3d(acPoint3d.X + Ldis, acPoint3d.Y - Ldis, 0)
                Dim acPoint3d4 As Point3d = New Point3d(acPoint3d.X - Ldis, acPoint3d.Y - Ldis, 0)
                Pt3dCOLL.Add(acPoint3d1)
                Pt3dCOLL.Add(acPoint3d2)
                Pt3dCOLL.Add(acPoint3d3)
                Pt3dCOLL.Add(acPoint3d4)
                '获取创建边界的对象集合
                Dim objs As DBObjectCollection = ed.TraceBoundary(acPoint3d, False)
                If objs.Count > 0 Then
                    Dim tr As Transaction = doc.TransactionManager.StartTransaction()
                    Using doc.LockDocument
                        Using tr
                            '我们将对象添加到模型空间
                            Dim bt As BlockTable = DirectCast(tr.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)
                            Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                            '将每个边界对象添加到块记录中,其ObjectId集合到ids集合
                            Dim ids As New ObjectIdCollection()
                            '' 定义对象数组中   Adds the circle to an object array
                            Dim acDBObjColl As DBObjectCollection = New DBObjectCollection()                            For Each obj As DBObject In objs
                                Dim ent As Entity = TryCast(obj, Entity)
                                If ent IsNot Nothing Then
                                    acDBObjColl.Add(ent)
                                    ids.Add(btr.AppendEntity(ent))
                                    tr.AddNewlyCreatedDBObject(ent, True)
                                End If
                            Next                            ''创建一个面域对象
                            Dim myRegionColl As DBObjectCollection = New DBObjectCollection()
                            myRegionColl = Autodesk.AutoCAD.DatabaseServices.Region.CreateFromCurves(acDBObjColl)
                            Dim acRegion As Region
                            acRegion = myRegionColl(0)
                            '' 添加新对象到块表记录和事务中   Add the new object to the block table record and the transaction
                            btr.AppendEntity(acRegion)
                            tr.AddNewlyCreatedDBObject(acRegion, True)
                            '提交事务
                            tr.Commit()
                        End Using
                    End Using
                End If
            Next
        Next