Check for outside event while acad is processing?

I have this loop that opens autocad and then opens drawings. If certain options are selected in a form (purge, plot, etc) the options are sent to autocad from VB6. I'm currently working on a cancel sub. As it sits, the best I can do I wait until autocad gets one drawing open completely and then it will cancel out before the next one opens. I'm wondering if there is a way for autocad to check for an outside event when it's opening or via a lisp routine? Or is DoEvents all I get? I put my loop code below - it is a mess, so please don't make fun...

Any help is always appreciated!



Dim PrgCnt As Integer
PrgCnt = 0

If chkOpenOnly.Value = Checked Then

intNumber = InStrLast(striFileName, "\")
strFilePath = Mid(striFileName, 1, intNumber)
ReDim strDwgs(0 To lstDrawings.ListCount - 1)
ReDim strDwgNumber(0 To lstDrawings.ListCount - 1)

For i = 0 To lstDrawings.ListCount - 1
DoEvents

If bCancel = True Or GetAsyncKeyState(vbKeyEscape) <> 0 Then
'MsgBox "bCancel Is True"
While frmDLPlot.Acad.Documents.Count > 0
frmDLPlot.Acad.ActiveDocument.Close (n)
Wend
frmProgress.Hide
Unload frmProgress
frmDLPlot.Show

GoTo EOF2
End If
DoEvents
strDwgs(i) = strFilePath & strDrawingNameList(i) & ".dwg"
If lstDrawings.Selected(i) = True Then
PrgCnt = PrgCnt + 1
If InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "00012" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "01014" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "01014-01" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-01" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-02" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-03" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-04" Then
bDullesSpecial = True
Else: bDullesSpecial = False
End If

DoEvents

If FileCheck.FileExists(strDwgs(i)) = True Then
If bDullesSpecial = True Then
On Error Resume Next
Kill (strDwgs(i))
If Err Then
Err.Clear
bErrMsgBox = True
bFileOpenMsg = True
strFileOpen = strFileOpen + strDrawingNameList(i) + " *OPEN FILE*" + vbCrLf

GoTo OPENNEXT

End If
Set dwg = Acad.Documents.Add(strDwgs(i))
Else
Set dwg = Acad.Documents.Open(strDwgs(i), False)
Acad.WindowState = acMax
Acad.ActiveDocument.WindowState = acMax
End If
ElseIf FileCheck.FileExists(strDwgs(i)) = False And bDullesSpecial = True Then
Set dwg = Acad.Documents.Add(strDwgs(i))
ElseIf FileCheck.FileExists(strDwgs(i)) = False And bDullesSpecial = False Then
bErrMsgBox = True
bFileExistsMsg = True
strFileExists = strFileExists + strDrawingNameList(i) + " *NOT FOUND*" + vbCrLf

AppActivate "DLP Progress"
GoTo OPENNEXT

End If

If bCancel = False Then
If InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "00012" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "01014" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "01014-01" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-01" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-02" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-03" Or InStrLast(strDrawingNameList(i), "_") > 1 And strCommission = "04004-04" Then
DoEvents
If strCommission = "00012" Then
AppActivate "DLP Progress"
DoEvents
If bCancel = False Then
DoEvents
AppActivate "dlplot"
dwg.SendCommand "(load ""h:/2000/00012/arch/support/newdwg"")" & vbCr
dwg.SendCommand "(NewDullesDwg " & """" & strDrawingNameList(i) & """)" & vbCr
End If
ElseIf strCommission = "01014" Then
dwg.SendCommand "(load ""h:/2001/01014/arch/support/NewTier2"")" & vbCr
dwg.SendCommand "(NewDullesDwg " & """" & strDrawingNameList(i) & """)" & vbCr
ElseIf strCommission = "01014-01" Then
dwg.SendCommand "(load ""h:/2001/01014-01/arch/support/NewTier2"")" & vbCr
dwg.SendCommand "(NewDullesDwg " & """" & strDrawingNameList(i) & """)" & vbCr

ElseIf strCommission = "04004" Or strCommission Like "04004*" Then
DoEvents
AppActivate "dlplot"
dwg.SendCommand "(load ""h:/2004/04004/arch/support/NewEds"")" & vbCr
dwg.SendCommand "(NewDullesDwg " & """" & strDrawingNameList(i) & """" & """" & strDwgDirectory & """)" & vbCr

End If
End If
AppActivate "dlplot"

DoEvents
If bCancel = True Or GetAsyncKeyState(vbKeyEscape) <> 0 Then
'MsgBox "bCancel Is True"
While frmDLPlot.Acad.Documents.Count > 0
frmDLPlot.Acad.ActiveDocument.Close (n)
Wend
frmProgress.Hide
Unload frmProgress
frmDLPlot.Show

GoTo EOF2
End If
End If
If chkDwup.Value = Checked And bDullesSpecial = False Then
dwg.SendCommand "dwup" & vbCr
End If
If chkUpdateSpanner = Checked Then
dwg.SendCommand ("sheetall" & vbCr)
End If
If chkPurge.Value = Checked Then
dwg.SendCommand ("pua" & vbCr)
End If
If chkChgco.Value = Checked Then
dwg.SendCommand ("chgco" & vbCr)
End If
If chkZoomExt.Value = Checked Then
dwg.SendCommand ("ze" & vbCr)
End If
End If

OPENNEXT:
'Setting Progress Bar values



If Not PrgCnt > frmProgress.prgDLP.Max Then
frmProgress.prgDLP.Value = PrgCnt
End If
frmProgress.lblProgress.Caption = frmProgress.prgDLP.Value


Next i