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

Тема: Ручной выбор обЪектов из VBA

Подскажите кто знает.
Как из VBA  с помощью указателя (ручного выбора)
выбрать один обЪект, определённого типа, из чертежа.
Что бы после выбора продолжалось выполнение программы. Как функция ENTSEL в LISP.
Я использую создание набора, примерно следующее.

    gpCode(0) = 0
    dataValue(0) = "Dimension"
    groupCode = gpCode
    dataCode = dataValue
    Set sset = ThisDrawing.SelectionSets.Add("SSS")
    sset.SelectOnScreen groupCode, dataCode

Но такой тип выбора требует подтверждения окончания операции выбора.
Подскажите пожалуйста как делать правильно. Или для этого  в VBA есть специальная функция.

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

Re: Ручной выбор обЪектов из VBA

Для выбора одного объекта ипользуется метод ThisDrawing.Utility.GetEntity. Но он не обеспечивает выбор примитива определенного типа. Для этого надо делать дополнительные условия. Приблизительно так, как описано ниже. В примере обеспечивается выбор размера.

Option Explicit
Option Compare Text
Option Base 0
Sub selectObj()
Dim returnObj As AcadEntity
Dim varPnt, varCancel As Variant
Dim strObjName As String
Dim control As Boolean
On Error GoTo Error_Control
strObjName = "dimension"
control = False
Do Until control = True
    ThisDrawing.Utility.GetEntity returnObj, varPnt, vbCrLf & "Выберите объект:"
    If returnObj.ObjectName Like "*" & strObjName Then
        MsgBox "Размер:" & vbCr & vbTab & "тип: " & returnObj.ObjectName & vbCr & vbTab & _
               "слой: " & returnObj.Layer & vbCr & vbTab & "тип линии: " & returnObj.Linetype
        control = True
    Else
        MsgBox "Выбранный объект не является размером."
    End If
Loop
GoTo Exit_Here
Error_Control:
Select Case Err.Number
    Case -2147352567
        varCancel = ThisDrawing.GetVariable("LASTPROMPT")
        If InStr(1, varCancel, "*Cancel*") <> 0 Then
            ThisDrawing.Utility.Prompt "Выполнение программы прервано."
            Err.Clear
            Resume Exit_Here
        Else
            Err.Clear
            Resume
        End If
    Case -2145320928
        Err.Clear
        Resume Exit_Here
    Case Else
        MsgBox Err.Description & " " & Err.Number
        Err.Clear
        Resume Exit_Here
End Select
Exit_Here:
Set returnObj = Nothing
Set varPnt = Nothing
Set varCancel = Nothing
End Sub

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

Re: Ручной выбор обЪектов из VBA

Спасибо, всё работает.   :) 
Осталось только разобоаться в коде.