【求助】大神看一下我的代码错在哪里？
代码运行后，不能停止循环，按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
消灭零回复 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
怎么可能在程序运行到IF之前响应到ESC按键呢？所以不会停 循环内加一个 on error goto uuu
代码底部加一个 uuu：
页:
[1]