<CommandMethod("Test1", CommandFlags.Modal)>
Public Sub Test1()
'' Запрос текущего документа, редактора и базы данных
Dim acDocument = Core.Application.DocumentManager.MdiActiveDocument
Dim acEditor = acDocument.Editor
Dim acDatabase = acDocument.Database
'' Запрос объекта
Dim prmtSelectOpts = New PromptSelectionOptions()
prmtSelectOpts.MessageForAdding = vbCrLf & "Выберите отрезок или полилинию : "
prmtSelectOpts.SingleOnly = True
prmtSelectOpts.SinglePickInSpace = True
prmtSelectOpts.ForceSubSelections = True '' Выбор только подобъектов объектов
Dim prmtSelectResult As PromptSelectionResult = acEditor.GetSelection(prmtSelectOpts)
If (prmtSelectResult.Status <> PromptStatus.OK) Then Return
Dim acSelectSet As SelectionSet = prmtSelectResult.Value
Dim acSelectObj As SelectedObject = acSelectSet(0)
Dim acValidTypes() As Type = {GetType(Line), GetType(Polyline), GetType(Polyline2d), GetType(Polyline3d)}
Dim acValidType = CheckType(acSelectObj.ObjectId, acValidTypes)
If Not acValidType Then
acEditor.WriteMessage("Выбран объект неверного типа...")
Return
End If
'' Выполняем доступ к объекту по его ObjectId
Using acTransaction As Transaction = acDatabase.TransactionManager.StartTransaction()
Dim acCurve As Curve = acTransaction.GetObject(acSelectObj.ObjectId, OpenMode.ForWrite)
Dim acSelSubObj As SelectedSubObject() = acSelectObj.GetSubentities()
Dim acSubObjType = acSelSubObj(0).FullSubentityPath.SubentId.Type
Dim acValidLine = acSubObjType = SubentityType.Edge
If Not acValidLine Then
acEditor.WriteMessage("Неправильный тип подобъекта: " & acSubObjType.ToString() & ", повторите снова...")
Return
End If
Dim acSubEntityId As SubentityId = acSelSubObj(0).FullSubentityPath.SubentId
'' Создаём путь к подобъекту для использования в GetSubentity
Dim subEntityPath As FullSubentityPath = New FullSubentityPath(New ObjectId() {acCurve.ObjectId}, acSubEntityId)
Dim asSubEntity As Entity = acCurve.GetSubentity(subEntityPath)
acEditor.WriteMessage("Тип подобъекта : " & asSubEntity.ToString())
'' ????????????????????????????
asSubEntity.Highlight()
'' ????????????????????????????
acTransaction.Commit()
End Using
End Sub
Private Function CheckType(ObjId As ObjectId,
acTypes() As Type) As Boolean
Dim acResult As Boolean = False
For Each acType In acTypes
acResult = ObjId.ObjectClass.IsDerivedFrom(RXClass.GetClass(acType))
If acResult Then Exit For
Next
Return acResult
End Function