HELP..! VBA Code Runs Correctly but Causes a Fatal Error

[CADdancer]

Hi AUGI Members,

Attached is a VBA script that is designed to save all open AutoCAD drawing files to DXF format. The code runs correctly but after the last drawing is saved into DXF format AutoCAD crashes with a "Fatal Error" message. We are currently using AutoCAD Architecture 2013.....running on 64bit Windows 7 workstations.

Hopefully the forum experts can identify what is causing the difficulty....? Any recommendations or suggestions will be appreciated....!



Regards,
Vince

[Ed Jobe]

Sub DSaveAllDXF()
Dim Document As AcadDocument
Dim Documents As AcadDocuments
Dim sFileName As String
Dim sHold As String
Set Documents = ThisDrawing.Application.Documents
Dim RetVal As Variant
RetVal = MsgBox("...Save All DCE Drawings In DXF Format...?", vbYesNo, "Save All")
For Each Document In Documents
document.SaveAs(thisdrawing.Name,
If RetVal = vbYes Then
Document.Activate
ThisDrawing.ActiveSpace = acModelSpace
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
Application.ZoomExtents
sHold = ThisDrawing.Name
sFileName = Left(sHold, (Len(sHold) - 4))

ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr & "SaveAs" & vbCr & "DXF" & vbCr & "" & vbCr & "" & vbCr
ThisDrawing.SendCommand "filedia" & vbCr & "1" & vbCr
ThisDrawing.Close
Else
ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr & "SaveAs" & vbCr & "DXF" & vbCr & "" & vbCr & "" & vbCr
ThisDrawing.SendCommand "filedia" & vbCr & "1" & vbCr
End If
Next
End SubThe main problem is that you are using SendCommand. It is an asyncronous method, i.e. it will process after all the vba is finished. However, the Document.Close method is synchronous, so it will process before the SendCommand method. When you get to the last document, it will close and then you will have SendCommand trying to run in a zero document state, trying to refer to memory locations that have already gone out of scope.

You might also consider some other logic so that you don't end up in a zero document state. Instead of for..each over the documents collection, you could set up a counter to monitor the document count and keep the last document open.

[CADdancer]

Hi Ed,

Thank you for your response and feedback........can I impose upon you to show me an example of how to utilize a synchronous method for the following "ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr & "SaveAs" & vbCr & "DXF" & vbCr & "" & vbCr & "" & vbCr" This would be very helpful to me in correcting the remainder of the code....??


Thanks again,
Vince

[Ed Jobe]

Here is the revised code. I did some additional cleanup. Check for inline comments.


Sub DSaveAllDXF()
Dim Document As AcadDocument
'Dim Documents As AcadDocuments
Dim sFileName As String
Dim sHold As String
' You don't need a variable for this.
' Just use AcadApplication
'Set Documents = ThisDrawing.Application.Documents
Dim RetVal As Variant
RetVal = MsgBox("...Save All DCE Drawings In DXF Format...?", vbYesNo, "Save All")
For Each Document In AcadApplication.Documents
' Check for open docs with unsaved changes.
If RetVal = vbYes And Document.GetVariable("DBMOD") > 0 And Not Document.Name Like "Drawing*" Then
Document.Activate 'This isn't necessary when using the SaveAs method.
ThisDrawing.ActiveSpace = acModelSpace
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
Application.ZoomExtents
sHold = ThisDrawing.Name
sFileName = Left(sHold, (Len(sHold) - 4))

ThisDrawing.SaveAs(sFileName, ac2013_dxf)
ThisDrawing.Close
Else
Exit Sub
' Changed to match dialog prompt.
End If
Next
End Sub

[CADdancer]

Hi Ed,

Thank you for your assistance.....!

I have some other VBA code that I am having difficulty try to convert to the synchronous method......is it possible for you to help me with this...??



'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~MAKE THE BIND~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub cmdArchive_Click()

Dim i
''''Iterate through each file in the list
For i = 0 To lstSelectDwgs.ListCount - 1

''''OPEN EACH DRAWING IN THE SELECT LIST
Application.Documents.Open CurPath & lstSelectDwgs.List(i)

''''SET BIND TYPE VARIABLE
If OptionButton4 Then
ThisDrawing.SendCommand "SetVar" & vbCr & "BindType" & vbCr & "0" & vbCr
End If

If OptionButton5 Then
ThisDrawing.SendCommand "SetVar" & vbCr & "BindType" & vbCr & "1" & vbCr
End If


'Turn Off Layers in the selected directory

If CheckBox1 Then
ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr & "TILEMODE" & vbCr & "0" & vbCr & "ZOOM" & vbCr & "extents" & vbCr & "filedia" & vbCr & "1" & vbCr
ThisDrawing.SendCommand "-xref" & vbCr & "reload" & vbCr & "*" & vbCr
End If

If CheckBox2 Then
ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr & "TILEMODE" & vbCr & "0" & vbCr & "ZOOM" & vbCr & "extents" & vbCr & "filedia" & vbCr & "1" & vbCr
ThisDrawing.SendCommand "-xref" & vbCr & "bind" & vbCr & "*" & vbCr
End If

If OptionButton2 Then
ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr & "TILEMODE" & vbCr & "0" & vbCr & "ZOOM" & vbCr & "extents" & vbCr & "filedia" & vbCr & "1" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "S" & vbCr & "0" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "on" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "T" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "U" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "on" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "T" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "U" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "on" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "T" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "U" & vbCr & "*arch*" & vbCr & "" & vbCr
End If

If OptionButton3 Then
ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr & "TILEMODE" & vbCr & "0" & vbCr & "ZOOM" & vbCr & "extents" & vbCr & "filedia" & vbCr & "1" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "S" & vbCr & "0" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "off" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "F" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "LO" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "off" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "F" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "LO" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "off" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "F" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "LO" & vbCr & "*arch*" & vbCr & "" & vbCr
End If

ThisDrawing.Close

' lstArchived.AddItem lstSelectDwgs.List(i) & "- is Archived"
Next i

'Open and Complete file operations for each file
Dim j
For j = 0 To lstArchivedFiles.ListCount - 1

Application.Documents.Open NewDir & lstSelectDwgs.List(i)


ThisDrawing.Close

Next j

End Sub


Thank you again for your expert help...!


Regards,
Vince

[Ed Jobe]

Take a look at ThisDrawing.SetVariable, ThisDrawing.Layers and ThisDrawing.ActiveLayer.

[CADdancer]

Hi Ed,

Thank you for your suggestions.......I have made progress setting the variables with "ThisDrawing.SetVariable" and handling the layers with the "ThisDrawing.Layers" however, I am having difficulty attempting to reload the X-reference files. Could you possibly show me an example of how to accomplish this....??


Regards,
Vince

[Ed Jobe]

This test code should iterate all the blocks, check for xrefs, then reload/bind.

Sub testbind()
Dim blk As AcadBlock

For Each blk In ThisDrawing.Blocks
If blk.IsXRef Then
If Checkbox1 Then blk.Reload
blk.Bind False 'false option leaves off parent prefix
End If
Next blk
End Sub

[CADdancer]

Hi Ed,

I tried to make some of the changes to the VBA routine but I still seem to be experiencing difficulty in the code running smoothly. Can you take a look and the code below to see if I have coded things correctly....??



'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~BIND THE DRAWINGS~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub cmdArchive_Click()
Dim xrefHome As AcadBlock
Dim xrefInserted As AcadExternalReference
Dim i
Dim blk As AcadBlock
''''Iterate through each file in the list
For i = 0 To lstSelectDwgs.ListCount - 1

''''OPEN EACH DRAWING IN THE SELECT LIST
Application.Documents.Open CurPath & lstSelectDwgs.List(i)

''''SET BIND TYPE VARIABLE
If OptionButton4 Then
ThisDrawing.SetVariable "BindType", 0#
End If

If OptionButton5 Then
ThisDrawing.SetVariable "BindType", 1#
End If


'Turn Off Layers in the selected directory

If CheckBox1 Then
ThisDrawing.SetVariable "FileDia", 0#
ThisDrawing.SetVariable "TileMode", 0#
Application.ZoomExtents
ThisDrawing.SetVariable "FileDia", 1#


For Each blk In ThisDrawing.Blocks
If blk.IsXRef Then
If CheckBox1 Then blk.Reload
blk.Bind False 'false option leaves off parent prefix
End If
Next blk

End If

If CheckBox2 Then
ThisDrawing.SetVariable "FileDia", 0#
ThisDrawing.SetVariable "TileMode", 0#
Application.ZoomExtents
ThisDrawing.SetVariable "FileDia", 1#

For Each blk In ThisDrawing.Blocks
If blk.IsXRef Then
If CheckBox2 Then blk.Reload
blk.Bind False 'false option leaves off parent prefix
End If
Next blk

End If

If OptionButton2 Then
ThisDrawing.SetVariable "FileDia", 0#
ThisDrawing.SetVariable "TileMode", 0#
Application.ZoomExtents
ThisDrawing.SetVariable "FileDia", 1#

ThisDrawing.SendCommand "-layer" & vbCr & "S" & vbCr & "0" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "on" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "T" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "U" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "on" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "T" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "U" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "on" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "T" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "U" & vbCr & "*arch*" & vbCr & "" & vbCr
End If

If OptionButton3 Then
ThisDrawing.SetVariable "FileDia", 0#
ThisDrawing.SetVariable "TileMode", 0#
Application.ZoomExtents
ThisDrawing.SetVariable "FileDia", 1#

ThisDrawing.SendCommand "-layer" & vbCr & "S" & vbCr & "0" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "off" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "F" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "LO" & vbCr & "*S-arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "off" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "F" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "LO" & vbCr & "a-*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "off" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "F" & vbCr & "*arch*" & vbCr & "" & vbCr
ThisDrawing.SendCommand "-layer" & vbCr & "LO" & vbCr & "*arch*" & vbCr & "" & vbCr
End If

ThisDrawing.Close

Next i

'Open and Complete file operations for each file
Dim j
For j = 0 To lstArchivedFiles.ListCount - 1

Application.Documents.Open NewDir & lstSelectDwgs.List(i)


ThisDrawing.Close

Next j

End Sub



Your assistance will be appreciated....!!



Regards,
Vince

[Ed Jobe]

What difficulty are you experiencing? Can you be more specific?

[CADdancer]

Hi Ed,

The routine starts and opens the first drawing then literally stops for a few minutes then closes that drawing and opens the next one and hangs for another 2-5 minutes and then closes it and moves on to the next etc, until all the selected drawings are processed. however, this that's very long time because it takes 2-5 minutes per drawing....!

Thank you for your reply,
Vince

[CADdancer]

Hi AUGI Members,

I am having difficulty with some code and have gotten some input and tried to write the code correctly however, the routine runs very slow taking between 2-5 minutes for each drawing before moving on to the next one. Can anyone take a look at the code in Thread #9 and let me know what I am doing incorrectly or make some direction on how to resolve the problem....??

Your assistance is appreciated...!!


Regards, Vince