Hi to everybody,
I have a strange error occuring in my program, it works fine unless I import ONLY blocks from an external drawing, in this case AutoCAD crashes when exiting.
Another strange thing about the issue is that if I import ther ents with the block I have no problem, or, if I terminate the execution of the code with a "me.close()" and save the drawing, I get the error, but when I re-open the drawing my blocks are there, but if I continue the execution of the program, I get no error, but the blocks magically disapear.
Sub Import_Blocks()
' Create the destination layer and set it as current
'<< Here I call a sub that creats and sets the newly created Layer As Current >>
' Get Ents from Source Drawing into Current Drawing
' Loop Items in "lstBundlig" (this is a listbox in my form): the Source Layers with the ents to import
' THIS IS NOT relevant to the issue!!!
For Each mySrcLay As Object In lstBundling.Items
Dim SrcLayName As String = ""
' Get the Real Source LayerName
For i As Integer = 0 To UBound(GTAMdrLays, 2)
If mySrcLay = GTAMdrLays(1, i) Then
SrcLayName = GTAMdrLays(0, i) ' the Source Layer Name
Exit For
End If
Next
' Get the DefaultEntity
Dim DefaultEntity As String = ""
For i As Integer = 0 To UBound(CartaMadre, 2)
If mySrcLay = CartaMadre(3, i) Then
DefaultEntity = CartaMadre(10, i) ' the DefaultEntity type
Exit For
End If
Next
' Import Layer with Ents
WblockLayerIN(GtaBundleSource, SrcLayName) ' this sub clones in all ents from the source drawing
' Update the WblockCloned objects: bring them in my destination layer
Dim mySS As EditorInput.SelectionSet = SSLayer(SrcLayName)
If Not IsNothing(mySS) Then
Dim myDWG As ApplicationServices.Document = _
ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim myDB As DatabaseServices.Database = myDWG.Database
Dim myTransMan = myDWG.TransactionManager
Dim myTrans = myTransMan.StartTransaction
Dim myEd As EditorInput.Editor = myDWG.Editor
Dim myObjIds As DatabaseServices.ObjectIdCollection = _
New DatabaseServices.ObjectIdCollection(mySS.GetObjectIds)
' Loop ents in SelectionSet
For Each myObjId As DatabaseServices.ObjectId In myObjIds
Dim myAcadEnt As DatabaseServices.Entity = myObjId.GetObject(OpenMode.ForRead)
' Update Cloned Entity
' Add Xrecord to the Cloned Entity
' THIS IS NOT relevant to the issue!!!
AddGTAXRecord(myAcadEnt, SrcLayName)
' Modify entity to match destination Layer
With myAcadEnt
' Move entity to the layer
.UpgradeOpen()
.Layer = lblBundle.Text
' Update complex ents
If TypeOf myAcadEnt Is DatabaseServices.Hatch Then
Dim myHatch As DatabaseServices.Hatch = myAcadEnt
' Update the Hatch
End If
.DowngradeOpen()
' Check if the Entity must be cloned
Dim ClonedEnt As Boolean = False
Select Case myAcadEnt.GetType.Name
Case "Hatch"
If DefaultEntity = "isPattern" Then ClonedEnt = True
Case "Polyline", "Polyline2d", "Polyline3d"
If DefaultEntity = "isLType" Then ClonedEnt = True
Case "BlockReference"
If DefaultEntity = "isSimbol" Then ClonedEnt = True
End Select
If TypeOf myAcadEnt Is DatabaseServices.Hatch And Not ClonedEnt Then
' User has hatches in a Polyline layer type.
' Clone also the hatch
ElseIf Not ClonedEnt Then
' entity must not be cloned: delete it from current drawing
.Erase()
.Dispose()
End If
End With ' End of Modify entity to match Bundle
Next ' End of Loop ents in SelectionSet
' Commit and Dispose Transactions
myTrans.Commit() : myTrans.Dispose() : myTransMan.Dispose()
' Update screen
myEd.Regen()
End If
' If I exit here, I have the blocks, but exiting AutoCAD I get the fatal error
' if I comment the following line of code, I don't get the error but I lose the blocks!
Me.Close()
' Remove the source layer definition from tha LayerTable
RemoveLayer(SrcLayName)
Next ' End of Loop Items
End Sub
Any help appreciated
Thanks in advance
René
