[VBA程序]：如何终止一个命令？

fyxzi

在程序运行完，有时候会有个命令还在运行，使的程序不能继续下去，必须按“esc”键退出，请问下，由什么方法在程序里终止这个命令？

zml84

我想知道，既然命令是有程序引发的，那么为什么不能确认命令是否结束呢？

如果确认命令尚未结束，那么执行
(command)
就相当于按下“ESC”。

fyxzi

首先谢谢下.至于为什么不能确认命令是否结束，我也不知道。
程序是借鉴“明经通道”里面的一个事例，就是复制一个document中的内容到一个变量中，然后建立一个新的document，在把复制的内容添加到新的中，但在删除原先的document时究竟出现了那个问题。

zml84

不知楼主能否将该段模拟程序贴出来，大家共同探讨一下？
*-*9

fyxzi

这个代码如下:

'***************************************************************************
'确定按钮单击事件，创建一个块，并将dxf文件的内容添加到块中
'将块插入到当前新建图形中
'***************************************************************************
Private Sub cmdOK_Click()
    On Error Resume Next
   
    Dim ss As AcadSelectionSet
    Dim objCurDoc As AcadDocument
    Dim objNewDoc As AcadDocument

    ' 判断图形是否存在
    If Len(Dir(tbName.Text)) = 0 Then
        MsgBox "指定的图形不存在！", vbCritical
        Exit Sub
    End If

    ' 保存目前的文档
    Set objCurDoc = ThisDrawing.Application.ActiveDocument

    Dim ptBase(0 To 2) As Double
    ptBase(0) = 0#
    ptBase(1) = 0#
    ptBase(2) = 0#

        ' 创建块定义
    Dim objBlkDef As AcadBlock
    Dim nameBlock As String

    nameBlock = InputBox$("请输入块的名称：", "创建图层叠加的块", "")
    If HasBlkDef(nameBlock) Then
       If MsgBox("已存在同名的块！是否替换?", vbYesNo + vbExclamation, "警告") = vbYes Then
          DeleteBlkDef nameBlock
          Set objBlkDef = ThisDrawing.Blocks.Add(ptBase, nameBlock)
       Else
          Exit Sub
       End If
    Else
       Set objBlkDef = ThisDrawing.Blocks.Add(ptBase, nameBlock)
    End If

    Unload Me
   
    ' 打开一个新图形
    Set objNewDoc = ThisDrawing.Application.Documents.Open(tbName.Text)

    Dim ft(0) As Integer, fd(0)
    ft(0) = 8
    fd(0) = "GSLAYER"

    Set ss = ThisDrawing.ActiveSelectionSet
    ss.Clear
    ss.Select acSelectionSetAll, , , ft, fd
        
    ' 将选择集中的实体添加到数组中
    Dim objCollection() As Object
    ReDim objCollection(ss.Count - 1)
    Dim i As Integer
    For i = 0 To ss.Count - 1
        Set objCollection(i) = ss.Item(i)
    Next i
    ss.Delete

    '将数组中的实体添加到块中
    ThisDrawing.CopyObjects objCollection, objBlkDef
    objNewDoc.Close

    '将块插入到当前图形中
    Dim blockRefObj As AcadBlockReference
   
    '指定为当前图层
    Set layerObj = ThisDrawing.Layers.Add("Superpose")
    ThisDrawing.ActiveLayer = layerObj
   
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(ptBase, nameBlock, 1#, 1#, 1#, 0)

    ThisDrawing.Application.ZoomExtents

End Sub

就上在运行到"    objNewDoc.Close"时出现的问题,大家看看,给点已经,谢谢了

fyxzi

试了，可是那不是错误，到那里还是那么执行，没什么反应