[Serge_Y]

Всем привет!
Есть кусок кода:
...
' Create the selection set
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.SelectionSets.Add("TEST_SSET")
' Add objects to a selection set by prompting user to select on the screen
ss.SelectOnScreen
' Create the block
On Error Resume Next
Dim returnPnt As Variant
Dim blockObj As AcadBlock
Dim basePnt(0 To 2) As Double
basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
returnPnt = ThisDrawing.Utility.GetPoint(basePnt, "Specify base point:")
Set blockObj = ThisDrawing.Blocks.Add(returnPnt, "TempCopy")
...
Вопрос: при выполнении этого куска программы при нажатии esc(перед указанием точки на чертеже), выдается сообщение: "Method 'GetPoint' of object IAcadUtility failed". Подскажите плз как обработать этот фрагмент, чтобы программа "тихо" выходила в Автокад без ругательств.
Спасибо

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

Попробуй, например, получить точку так:

Код:

[Выделить все]

Function GetPointNoError(Optional MessageString As String) As Variant
Dim SysVarNomutt As Integer, SysVarCmdecho As Integer
Dim pt As AcadPoint
  If IsMissing(MessageString) Or Trim(MessageString) = "" Then
    ThisDrawing.Utility.Prompt "Укажите точку <Отмена> : "
  Else
    ThisDrawing.Utility.Prompt MessageString
  End If
  SysVarCmdecho = ThisDrawing.GetVariable("cmdecho")
  SysVarNomutt = ThisDrawing.GetVariable("nomutt")
  On Error GoTo lRestoreSysVar
  pt = ThisDrawing.Utility.GetPoint
  GetPointNoError = pt
lRestoreSysVar:
  ThisDrawing.SetVariable "cmdecho", SysVarCmdecho
  ThisDrawing.SetVariable "nomutt", SysVarNomutt
  Exit Function
End Function

В качестве проверки:

Код:

[Выделить все]

Sub test()
Dim point As Variant
  point = GetPointNoError()
  If Not (IsEmpty(point)) Then
    MsgBox CStr(point(0)) & ", " & CStr(point(1)) & "," & CStr(point(2))
  End If
  point = GetPointNoError("test")
  If Not (IsEmpty(point)) Then
    MsgBox CStr(point(0)) & ", " & CStr(point(1)) & "," & CStr(point(2))
  End If
End Sub

[Serge_Y]

Запускаю макрос "Test". Указываю точку на чертеже, получаю сообщение: " Run-time error 91: Object Variable or With block variable not set". Дебаггер возвращает к следующей строке кода: "pt = ThisDrawing.Utility.GetPoint".
Если же жму esc, то получаю все тот же:"Method 'GetPoint' of object IAcadUtility failed" Run-time error 2147352567(80020009)

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

Я проверял на ADT2005 и 2006... Все работало корректно. Специально только что перепроверил на заново запущенном каде - глюков не обнаружено.
---
Добавлено: Блин, не тот тип переменной у point... Надо Variant. Скопировал не то
Исправленный вариант:

Код:

[Выделить все]

Function GetPointNoError(Optional MessageString As String) As Variant
Dim SysVarNomutt As Integer, SysVarCmdecho As Integer
Dim pt As Variant
  If IsMissing(MessageString) Or Trim(MessageString) = "" Then
    MessageString = "Укажите точку <Отмена> : "
  End If
  SysVarCmdecho = ThisDrawing.GetVariable("cmdecho")
  SysVarNomutt = ThisDrawing.GetVariable("nomutt")
  On Error GoTo lRestoreSysVar
  pt = ThisDrawing.Utility.GetPoint(, MessageString)
  GetPointNoError = pt
lRestoreSysVar:
  ThisDrawing.SetVariable "cmdecho", SysVarCmdecho
  ThisDrawing.SetVariable "nomutt", SysVarNomutt
  Exit Function
End Function

Sub test()
Dim point As Variant
  point = GetPointNoError()
  If Not (IsEmpty(point)) Then
    MsgBox CStr(point(0)) & ", " & CStr(point(1)) & "," & CStr(point(2))
  Else
    MsgBox "error!"
  End If
End Sub

[Serge_Y]

Блин, ну не хватает опыта еще в программировании. В опциях на закладке "General" стояла галка на "break on all errors" [sm2103]
А так, конечно же все работает, спасибо

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

Корректно работает второй код! Учти!

[fixo]

Без комментариев

Код:

[Выделить все]

'' written by Tony Tanzillo
'' request check "Break on Unhandled Errors" in  General options
Public Sub LoopExample()
Dim Msg As String
Msg = vbCrLf & "First point: "
Dim MyPoint As Variant
Do
On Error Resume Next
MyPoint = ThisDrawing.Utility.GetPoint(, Msg)
If Err Then
Err.Clear
Exit Do
End If
On Error GoTo 0

' Process the entered point here
ThisDrawing.ModelSpace.AddCircle MyPoint, 10#
Msg = vbCrLf & "Next point or ENTER to exit: "
Loop
On Error GoTo 0

End Sub

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

С богами не спорят, им внимают

[fixo]

Да, у этого перца иногда такие шедевры бывают...



~'J'~