'' Запрос линии или сегмента полилинии
'' Описание проблемы см. в следующей процедуре
Public Sub QueryLine(ByVal acEditor As Editor,
ByRef acLineId As ObjectId,
ByRef acLinePickPoint As Point3d,
ByRef acCommandSuccess As Boolean)
'' Определение параметров запроса ПРИМИТИВА
Dim prmtEntityOpts As PromptEntityOptions = New PromptEntityOptions("")
prmtEntityOpts.Message = "Укажите линию или полилинию"
prmtEntityOpts.SetRejectMessage("Выбран примитив недопустимого типа")
prmtEntityOpts.AllowNone = False
prmtEntityOpts.AllowObjectOnLockedLayer = True
'' Определение необходимых инструментов запроса
Dim acEventSelection = New PromptForEntityEndingEventHandler(AddressOf Event_SelectEntity)
Dim prmtEntityResult As PromptEntityResult
'' Выполнение запроса ПРИМИТИВА
AddHandler acEditor.PromptForEntityEnding, acEventSelection
prmtEntityResult = acEditor.GetEntity(prmtEntityOpts)
RemoveHandler acEditor.PromptForEntityEnding, acEventSelection
'' Оценка успешности выполнения запроса
acCommandSuccess = prmtEntityResult.Status = PromptStatus.OK
If Not acCommandSuccess Then Return
'' Возвращение результата пользовательского выбора
acLineId = prmtEntityResult.ObjectId
acLinePickPoint = prmtEntityResult.PickedPoint
End Sub
Private Sub Event_SelectEntity_CornerLine(ByVal Sender As Object,
ByVal acResultArgs As PromptForEntityEndingEventArgs)
'' Объявление внутренних переменных
Dim acEditor As Editor = CType(Sender, Editor)
Dim acSelObjId As ObjectId = acResultArgs.Result.ObjectId
Dim acSelObjPnt As Point3d = acResultArgs.Result.PickedPoint
'' Здесь мы анализируем свойства выделенной кривой и на их основании определяем, подходит кривая или нет
'' Одно из условий - при повторном использовании процедуры выбора, выбранная кривая не должна быть той же самой, что и предыдущая
'' То есть должна быть в рамках исполнения команды уникальной из выбранных пользователем
'' Как сюда передать ObjectId ранее выбранной кривой для проверки на Equal ???
'' Вообще-то это частность. В общем случае сюда же нужно засунуть процедуру на предварительную отрисовку результата выполнения
'' моей команды "на лету" в зависимости от примитива, находящегося под курсором (для исключения дублирования длинного кода)
'' Можно конечно через переменную, объявленную уровнем выше процедуры или функции, в рамках того же класса
'' Но тогда нужно отдельно ее контролировать. Лучше и чище было бы получить ее в качестве аргумента данной функции.
'' Экзотический способ пометки уже выбранной кривой пользовательским свойством - тоже как то громоздко и ненадежно.
'' Что скажут уважемые гуру ?
Dim acCheckCode = ... '' Здесь должна быть функция проверки
'' Если оценка отрицательная объекта - удаляем примитив из выбора
If acCheckCode <> CODE_CURVE_IS_VALID Then
acResultArgs.RemoveSelectedObject()
EditorMsg(acEditor, msa_Curve_Analysis_Result(acCheckCode))
End If
End Sub
