Сообщество программистов Autodesk в СНГ

ADN Club => VBA => Тема начата: wavaw от 29-08-2017, 16:34:58

Название: завершение цикла кнопкой Esc
Отправлено: wavaw от 29-08-2017, 16:34:58
здравствуйте.
подскажите, пожалуйста, как дополнить код, чтобы появился обработчик ошибки на клавишу 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
Название: Re: завершение цикла кнопкой Esc
Отправлено: Алексей Кулик от 29-08-2017, 19:57:27
Возможно, сработает конструкция On Error Goto
Название: Re: завершение цикла кнопкой Esc
Отправлено: Александр Ривилис от 29-08-2017, 21:12:31
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
Название: Re: завершение цикла кнопкой Esc
Отправлено: wavaw от 30-08-2017, 08:30:27
Алексей, Александр, благодарю за подсказку!
Александр, действительно мой случай)

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