завершение цикла кнопкой Esc

[wavaw]

здравствуйте.
подскажите, пожалуйста, как дополнить код, чтобы появился обработчик ошибки на клавишу Esc и была возможность завершить цикл без всплывающего окошка?

сам код цикла:

Код - Visual Basic [Выбрать]

1. Do While UBound(pp1) > 0
2.         pp2(0) = pp1(0): pp2(1) = pp1(1) - 15 * MyScale: pp2(2) = pp1(2)
3.         Set Line1 = ThisDrawing.ModelSpace.AddLine(pp1, pp2)
4.        
5.         'Добавляем мультитекст
6.        insertPoint(0) = pp1(0) - 1.25 * MyScale
7.         insertPoint(1) = pp1(1) - 7.5 * MyScale
8.         insertPoint(2) = 0
9.         width = 2.5 * MyScale
10.         If numberString = 0 Then
11.             textString = "ПК0"
12.         ElseIf numberString Mod 100 = 0 Then
13.             a = CStr(numberString \ 100)
14.             textString = "ПК" + a
15.         Else
16.             textString = CStr(numberString)
17.         End If
18.        
19.         ' Create a text Object in model space
20.        Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
21.         mtextObj.Rotation = 3.14 / 2
22.         mtextObj.BackgroundFill = True
23.         mtextObj.AttachmentPoint = acAttachmentPointMiddleCenter
24.                                
25.         pp1 = ThisDrawing.Utility.GetPoint(, "Укажите точку начала пикетирования (верхнию):")
26.         numberString = numberString + 0.5 * (pp1(0) - pp2(0)) / MyScale
27.     Loop

необходимо чтобы при запросе автокадом очередной точки при нажатии эскейпа цикл завершался без окошка дебага

весь код:

Код - Visual Basic [Выбрать]

1. Sub Piket()
2.     Dim pp1 As Variant
3.     Dim pp2(0 To 2) As Double
4.     Dim insertPoint(0 To 2) As Double
5.     Dim ПКначало As Double
6.     Dim mtextObj As AcadMText
7.     Dim width As Double
8.    'Dim textString As Variant
9.    Dim numberString As Double
10.            
11.     ПКначало = InputBox("Введите значение начального пикетажа в метрах (разделитель ТОЧКА):")
12.    
13.     pp1 = ThisDrawing.Utility.GetPoint(, "Укажите точку начала пикетирования (верхнию):")
14.     textString = 0: numberString = ПКначало
15.    
16.     Do While UBound(pp1) > 0
17.         pp2(0) = pp1(0): pp2(1) = pp1(1) - 15 * MyScale: pp2(2) = pp1(2)
18.         Set Line1 = ThisDrawing.ModelSpace.AddLine(pp1, pp2)
19.        
20.         'Добавляем мультитекст
21.        insertPoint(0) = pp1(0) - 1.25 * MyScale
22.         insertPoint(1) = pp1(1) - 7.5 * MyScale
23.         insertPoint(2) = 0
24.         width = 2.5 * MyScale
25.         If numberString = 0 Then
26.             textString = "ПК0"
27.         ElseIf numberString Mod 100 = 0 Then
28.             a = CStr(numberString \ 100)
29.             textString = "ПК" + a
30.         Else
31.             textString = CStr(numberString)
32.         End If
33.        
34.         ' Create a text Object in model space
35.        Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
36.         mtextObj.Rotation = 3.14 / 2
37.         mtextObj.BackgroundFill = True
38.         mtextObj.AttachmentPoint = acAttachmentPointMiddleCenter
39.                                
40.         pp1 = ThisDrawing.Utility.GetPoint(, "Укажите точку начала пикетирования (верхнию):")
41.         numberString = numberString + 0.5 * (pp1(0) - pp2(0)) / MyScale
42.     Loop
43.  
44. End Sub

[Алексей Кулик]

Возможно, сработает конструкция On Error Goto

[Александр Ривилис]

wavaw,
Не увлекайся спойлерами. Если длина кода < 300 строк и код несекретный, то спойлеры не нужны.

Оцени идею:

Код - Visual Basic [Выбрать]

1. '' written by Tony Tanzillo
2. '' request check "Break on Unhandled Errors" in  General options
3. Public Sub LoopExample()
4. Dim Msg As String
5. Msg = vbCrLf & "First point: "
6. Dim MyPoint As Variant
7. Do
8. On Error Resume Next
9. MyPoint = ThisDrawing.Utility.GetPoint(, Msg)
10. If Err Then
11. Err.Clear
12. Exit Do
13. End If
14. On Error GoTo 0
15.  
16. ' Process the entered point here
17. ThisDrawing.ModelSpace.AddCircle MyPoint, 10#
18. Msg = vbCrLf & "Next point or ENTER to exit: "
19. Loop
20. On Error GoTo 0
21.  
22. End Sub

[wavaw]

Алексей, Александр, благодарю за подсказку!
Александр, действительно мой случай)

Про обработку исключений тут https://msdn.microsoft.com/ru-ru/library/office/gg251688.aspx