【求助】大神看一下我的代码错在哪里？

yang6834137

代码运行后，不能停止循环，按ESC也不行。
Public Sub CreateXH()
    On Error Resume Next
    Dim color As New AcadAcCmColor '设置颜色
    color.ColorIndex = acGreen

    Dim pt1 As Variant
    Dim pt2(0 To 2) As Double
    Dim textObj As AcadText
    Dim num As Long
    Dim i As Long
    Dim height As Double
    Dim radius As Double
    Dim ptMin As Variant
    Dim ptMax As Variant
    Dim objCircle As AcadCircle

    radius = 5
    height = 5
    num = 1

    If KeyCode = vbKeyEscape Then
        Exit Sub
    End If
    For num = num To 99999
        If KeyCode = vbKeyEscape Then
            Exit Sub
        End If
        pt1 = ThisDrawing.Utility.GetPoint(, "请指定点:")
        Set textObj = ThisDrawing.ModelSpace.AddText(num, pt1, height)
        textObj.TrueColor = color
        textObj.GetBoundingBox ptMin, ptMax
        pt2(0) = (ptMin(0) + ptMax(0)) / 2
        pt2(1) = (ptMin(1) + ptMax(1)) / 2
        pt2(2) = (ptMin(2) + ptMax(2)) / 2
        Set objCircle = ThisDrawing.ModelSpace.AddCircle(pt2, radius)
        objCircle.TrueColor = color
        textObj.Update
    Next

End Sub

yang6834137

消灭零回复

mikewolf2k

    Err.Clear
    endPnt = ActiveDocument.Utility.GetPoint(endPnt, vbLf & "继续选择目标点,按右键或ESC退出:")
    If Not ((Err.Number = -2147467259) Or (Err.Number = -2147352567) Or (Err.Number = -2145320928)) Then GoTo MultiCopy

longxh28

怎么可能在程序运行到IF之前响应到ESC按键呢？所以不会停

ZZC18858664123

循环内加一个 on error goto uuu
代码底部加一个 uuu：