• Лена
  • Восстановленный участник
  • На форуме с 29 октября 2003г.
  • Сообщений: 2
  • Спасибо: 0

Тема: прозрачное выполнение команд

При выполнении макроса VBA необходимо прозрачное выполнение команд Автокада, типа зуммирование и привязка. Но при нажатии соорветствующей кнопки на панели инструментов макрос прекращается. Нужно чтобы полсе выполнения прозрачной команды продолжился макрос. Помогите.

  • Milz
  • Восстановленный участник
  • На форуме с 31 марта 2003г.
  • Сообщений: 27
  • Спасибо: 0

Re: прозрачное выполнение команд

Прекращается выполнение ThisDrawing.Utility.Get... по соотв. ошибке. Можно в цикле спрашивать у пользователя ввести что-либо пока не будут введены верные значения, напирсер, так:

Sub Test()
Dim Pnt As Variant
On Error Resume Next
Do
 Err.Clear
 Pnt = ThisDrawing.Utility.GetPoint(, "Укажите точку: ")
Loop While Err.Number <> 0
MsgBox CStr(Pnt(0)) & "," & CStr(Pnt(0)) & "," & CStr(Pnt(0))
End Sub

Но при этом нужно предусмотреть отмену! Например, по нажатию правой кнопке мыши выставлять флаг и проверять его в этом цикле. Иначе чтобы выйти из этого цикла пользователю придётся перезагружать автокад.

  • Лена
  • Восстановленный участник
  • На форуме с 29 октября 2003г.
  • Сообщений: 2
  • Спасибо: 0

Re: прозрачное выполнение команд

Спасибо за совет! Это выход, отмену реализовала следующим образом:
If Err.Number = -2145320928 Then
Exit Do
End If
происходит выход по правой кнопке или Enter. Может есть какой-то более простой и корректный способ (лучше только по ESC. И вообще у меня проблема с отслеживанием нажатия кнопок пользователем. Где можно об этом почитать кроме справки?). Заранее спасибо

  • Milz
  • Восстановленный участник
  • На форуме с 31 марта 2003г.
  • Сообщений: 27
  • Спасибо: 0

Re: прозрачное выполнение команд

Читать, к сожалению, негде. Остаётся только поставить автокад к стенке и пытать что же он может :)
По поводу отслеживания действий пользователя: я не нашол соответствующего события :( , хотя в принципе это  можно организовать при помощи установки ловушки на сообщение WH_KEYBOARD окна чертежа, подробнее см. http://delphi.mastak.ru/articles/hooks/index.html

  • bender
  • Восстановленный участник
  • На форуме с 5 мая 2003г.
  • Сообщений: 345
  • Спасибо: 0

Re: прозрачное выполнение команд

Зачем же к стенке. Отслеживание нажатия клавиш выглядит приблизительно так. Сразу прошу прошения у программистов за использование GoTo, все это конечно же можно организовать и в цикл.

Option Explicit
Option Compare Text
Option Base 0
Public Const VK_ESCAPE = &H1B
Public Const VK_RETURN = &HD
Public Const VK_RBUTTON = &H2
Public Const VK_LBUTTON = &H1
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const PM_REMOVE = &H1
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Sub test()
Dim insertPnt As Variant
On Error GoTo Error_Control
insertPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Command: Укажите точку вставки:")
MsgBox "Указана точка: " & insertPnt(0) & "," & insertPnt(1) & "," & insertPnt(2)
GoTo Exit_Here
Error_Control:
Select Case Err.Number
    Case -2147352567
        If checkkey(VK_ESCAPE) Then
            Err.Clear
            ThisDrawing.Utility.Prompt "Выполнение программы прервано." & vbCrLf
            GoTo Exit_Here
        Else
            If checkkey(VK_RBUTTON) Then
                MsgBox "Точка не указана!"
                Err.Clear
                Resume
            'и так далее и тому подобное
            Else
                Err.Clear
                Resume
            End If
        End If
    Case -2147467259
        If checkkey(VK_RBUTTON) Then
            MsgBox "Точка не указана!"
            Err.Clear
            Resume
        Else
            Err.Clear
            Resume
        End If
    Case Else
        MsgBox Err.Description & " " & Err.Number
        Err.Clear
        Resume Exit_Here
End Select
Exit_Here:
Set insertPnt = Nothing
End Sub
Public Function checkkey(ByVal lngKey As Long) As Boolean
If GetAsyncKeyState(lngKey) Then
    checkkey = True
Else
    checkkey = False
End If
End Function