Message 1 of 5
ReloadXrefs Error eWasOpenForRead exception
Not applicable
03-14-2012
02:12 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Public Class Start
<CommandMethod("ProgAR", CommandFlags.Session)> _
Public Sub ProgAR()
'initialisation
.....
Public Shared Function MaJXRefDansTable(ByRef OkErreur As Boolean, _
ByRef CollIdXref As ObjectIdCollection, _
ByRef strIndex As String) As Boolean
Dim OkRetour As Boolean = True
If strIndex = "" Then
strIndex = vbCrLf & "-->"
Else
strIndex = strIndex & "-->"
End If
'collection des ID pour vérifiation purge
Dim CollId As New ObjectIdCollection
'Recherche de tous les xref du desssin.
Dim mydb As Database = Application.DocumentManager.MdiActiveDocument.Database '= HostApplicationServices.WorkingDatabase
Dim myTrans As Transaction = mydb.TransactionManager.StartTransaction
'verrouillage du doc car modification !
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim DocLock As DocumentLock = doc.LockDocument
Try
'acces à la base des blocs
Dim BlocTable As BlockTable = CType(myTrans.GetObject(mydb.BlockTableId, OpenMode.ForRead), BlockTable)
For Each btid As ObjectId In BlocTable
Dim DefBloc As BlockTableRecord = CType(myTrans.GetObject(btid, OpenMode.ForWrite), BlockTableRecord)
'Si c'est une Xref non résolu
If DefBloc.IsFromExternalReference = True Then
'If DefBloc.IsResolved = False Then
'cherche un path
Dim Txt As String = GestionFichier.MiseAJourIndice(DefBloc.PathName, True)
If (Txt <> "") Then
CollId.Add(btid)
CollIdXref.Add(btid)
If (Txt.ToUpper <> DefBloc.PathName.ToUpper) Then
GestionAUTOCAD.EcrireSurLigneDeCommande(strIndex & DefBloc.Name & "-> " & "MaJ !")
DefBloc.PathName = Txt
'si MaJ alors sortie et relancer la procedure car si Xref Remise à jour
'la base globale est remise à jour de plus si un Xref dans Xref est en Supperposer
'(DefBloc.IsFromOverlayReference) il sera toujours dans la base
'donc il faut purger la base !
OkRetour = False
Else
'si path non changer mem de l'id pour vérifier si celui ci peut être purgé
'dans le cas ou l'Xref de l'Xref a été mis en Supperposé
End If
Else
OkErreur = True
GestionAUTOCAD.EcrireSurLigneDeCommande(strIndex & DefBloc.Name & "-> Impossible à trouver !")
End If
'Else
' CollIdXref.Add(btid)
'End If
End If
Next
myTrans.Commit()
Catch ex As Exception
MsgBox(ex.Message, vbOKOnly & vbCritical, "ee")
Finally
myTrans.Dispose()
End Try
DocLock.Dispose()
DocLock = Nothing
DocLock = doc.LockDocument
'regen du xref
If CollId.Count > 0 Then
mydb.ReloadXrefs(CollId) 'ne pas oublié le commit
'la fonction purge permet de savoir si les ID restant dans la collection
'peuvent être purgés
mydb.Purge(CollId) 'ne pas oublié le commit
If CollId.Count > 0 Then
myTrans = mydb.TransactionManager.StartTransaction
'purge des éléments restants
For Each Id As ObjectId In CollId
'sup des id xref car il va être éffacé
CollIdXref.Remove(Id)
'effacement
Dim obj As Object = myTrans.GetObject(Id, OpenMode.ForWrite)
obj.Erase(True)
Next
myTrans.Commit()
myTrans.Dispose()
End If
End If
DocLock.Dispose()
DocLock = Nothing
Return OkRetour
End Function
i have sometime a exception "eWasOpenForRead" on
mydb.ReloadXrefs(CollId)
The Xref was not on layer locked
but on another dwg it work fine..
I have not find a solution on internet. Could you help me please ?
Thanks