WblockCloneObjects trava após operação

#1
Função para importar blocos de um dwg para outro trava depois de concluída. Nenhuma exceção é gerada. Mas depois de algumas operações o Icad trava e apresenta "violação de memória".

Code: Select all

Public Shared Sub ImportBlocks(ByVal Bloco As String, ByVal FileName As String)
            Dim dm As DocumentCollection = acApp.Application.DocumentManager
            Dim ed As Editor = dm.MdiActiveDocument.Editor
            Dim destDb As Database = dm.MdiActiveDocument.Database
            Dim sourceDb As Database = New Database(False, True)
            Dim acLock As DocumentLock = dm.MdiActiveDocument.LockDocument()

            Try

                ' Read the DWG into a side database
                'Dim dwgPath As String = HostApplicationServices.Current.FindFile(FileName, sourceDb, FindFileHint.Default)
                sourceDb.ReadDwgFile(FileName, System.IO.FileShare.Read, True, "")

                ' Create a variable to store the list of block identifiers
                Dim blockIds As ObjectIdCollection = New ObjectIdCollection()

                Dim tm As Teigha.DatabaseServices.TransactionManager = sourceDb.TransactionManager

                Using myT As Transaction = tm.StartTransaction()
                    ' Open the block table
                    Dim bt As BlockTable = tm.GetObject(sourceDb.BlockTableId, teigha.DatabaseServices.OpenMode.ForRead, False)

                    '// Check each block in the block table
                    For Each btrId As ObjectId In bt

                        Dim btr As BlockTableRecord = tm.GetObject(btrId, teigha.DatabaseServices.OpenMode.ForRead, False)
                        '// Only add named & non-layout blocks to the copy list
                        If Not btr.IsAnonymous And Not btr.IsLayout And btr.Name = Bloco Then
                            blockIds.Add(btrId)
                            Exit For
                        Else
                            btr.Dispose()
                        End If
                    Next

                    ' copiar os estilos
                    Dim acDimStyleTbl As DimStyleTable
                    acDimStyleTbl = myT.GetObject(sourceDb.DimStyleTableId, teigha.DatabaseServices.OpenMode.ForRead, False)

                    Dim acDimStyleTblRec As DimStyleTableRecord
                    Dim acDimStyleTblRecCopy As DimStyleTableRecord = Nothing

                    If acDimStyleTbl.IsWriteEnabled = False Then acDimStyleTbl.UpgradeOpen()
                    Dim ds As DimStyleTable = myT.GetObject(sourceDb.DimStyleTableId, teigha.DatabaseServices.OpenMode.ForRead)

                    For Each objId As ObjectId In ds
                        acDimStyleTblRec = myT.GetObject(objId, teigha.DatabaseServices.OpenMode.ForRead)

                        If acDimStyleTbl.Has(acDimStyleTblRec.Name) = False Then
                            If acDimStyleTbl.IsWriteEnabled = False Then acDimStyleTbl.UpgradeOpen()


                            acDimStyleTblRec = myT.GetObject(objId, teigha.DatabaseServices.OpenMode.ForRead) 'New DimStyleTableRecord()


                            acDimStyleTbl.Add(acDimStyleTblRec)
                            myT.AddNewlyCreatedDBObject(acDimStyleTblRec, True)
                        End If

                    Next

                    '// Open the MlineStyle dictionary for read 


                    '// Copy blocks from source to destination database
                    Dim mapping As IdMapping = New IdMapping()
                    sourceDb.WblockCloneObjects(blockIds, destDb.BlockTableId, mapping, DuplicateRecordCloning.Replace, False)
                    'ed.WriteMessage("\nCopied " & blockIds.Count.ToString() & " block definitions from " & sourceFileName.StringResult & " to the current drawing.");

                    If Not sourceDb.IsDisposed Then
                        sourceDb.Dispose()

                    End If

                    If Not destDb.IsDisposed Then
                        destDb.Dispose()
                    End If

                    myT.Commit()
                End Using

            Catch ex As teigha.Runtime.Exception

                Intellicad.ApplicationServices.Application.ShowAlertDialog("Erro no procedimento de cópia " & FileName & ": " & ex.Message)
            End Try




        End Sub

Re: WblockCloneObjects trava após operação

#2
Try this:

Code: Select all

    Public Shared Sub ImportBlocks(ByVal Bloco As String, ByVal FileName As String)
        If (System.IO.File.Exists(FileName) = False) Then
            Application.ShowAlertDialog("File not found.")
            Return
        End If

        Dim dm As DocumentCollection = Application.DocumentManager
        Dim ed As Editor = dm.MdiActiveDocument.Editor
        Dim destDb As Database = dm.MdiActiveDocument.Database

        'Dim acLock As DocumentLock = dm.MdiActiveDocument.LockDocument()

        Try
            Dim sourceDb As Database = New Database(False, True)
            ' Read the DWG into a side database
            'Dim dwgPath As String = HostApplicationServices.Current.FindFile(FileName, sourceDb, FindFileHint.Default)
            sourceDb.ReadDwgFile(FileName, System.IO.FileShare.Read, True, "")

            ' Create a variable to store the list of block identifiers
            Dim blockIds As ObjectIdCollection = New ObjectIdCollection()

            'Dim tm As Teigha.DatabaseServices.TransactionManager = sourceDb.TransactionManager
            Using lockDoc As DocumentLock = dm.MdiActiveDocument.LockDocument()
                Using myT As Transaction = sourceDb.TransactionManager.StartTransaction()
                    ' Open the block table
                    Dim bt As BlockTable = myT.GetObject(sourceDb.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead, False)

                    '// Check each block in the block table
                    For Each btrId As ObjectId In bt

                        Dim btr As BlockTableRecord = myT.GetObject(btrId, Teigha.DatabaseServices.OpenMode.ForRead, False)
                        '// Only add named & non-layout blocks to the copy list
                        If Not btr.IsAnonymous And Not btr.IsLayout And btr.Name = Bloco Then
                            blockIds.Add(btrId)
                            Exit For
                        Else
                            btr.Dispose()
                        End If
                    Next

                    '' copiar os estilos
                    'Dim acDimStyleTbl As DimStyleTable
                    'acDimStyleTbl = myT.GetObject(sourceDb.DimStyleTableId, Teigha.DatabaseServices.OpenMode.ForRead, False)

                    'Dim acDimStyleTblRec As DimStyleTableRecord
                    'Dim acDimStyleTblRecCopy As DimStyleTableRecord = Nothing

                    'If acDimStyleTbl.IsWriteEnabled = False Then acDimStyleTbl.UpgradeOpen()
                    'Dim ds As DimStyleTable = myT.GetObject(sourceDb.DimStyleTableId, Teigha.DatabaseServices.OpenMode.ForRead)

                    'For Each objId As ObjectId In ds
                    '    acDimStyleTblRec = myT.GetObject(objId, Teigha.DatabaseServices.OpenMode.ForRead)

                    '    If acDimStyleTbl.Has(acDimStyleTblRec.Name) = False Then
                    '        If acDimStyleTbl.IsWriteEnabled = False Then acDimStyleTbl.UpgradeOpen()

                    '        acDimStyleTblRec = myT.GetObject(objId, Teigha.DatabaseServices.OpenMode.ForRead) 'New DimStyleTableRecord()

                    '        acDimStyleTbl.Add(acDimStyleTblRec)
                    '        myT.AddNewlyCreatedDBObject(acDimStyleTblRec, True)
                    '    End If
                    'Next

                    '// Open the MlineStyle dictionary for read 

                    If blockIds.Count <= 0 Then
                        Application.ShowAlertDialog("Not found Block named:" & Bloco)
                        Return
                    End If

                    '// Copy blocks from source to destination database
                    Dim mapping As IdMapping = New IdMapping()
                    sourceDb.WblockCloneObjects(blockIds, destDb.BlockTableId, mapping, DuplicateRecordCloning.Replace, False)
                    'ed.WriteMessage("\nCopied " & blockIds.Count.ToString() & " block definitions from " & sourceFileName.StringResult & " to the current drawing.");

                    'If Not sourceDb.IsDisposed Then
                    '    sourceDb.Dispose()
                    'End If

                    'If Not destDb.IsDisposed Then
                    '    destDb.Dispose()
                    'End If

                    myT.Commit()
                End Using
            End Using

        Catch ex As Teigha.Runtime.Exception
            IntelliCAD.ApplicationServices.Application.ShowAlertDialog("Erro no procedimento de cópia " & FileName & ": " & ex.Message)
        End Try
    End Sub