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

Тема: SelectByPolygon проблема с координатами

Здравствуйте!
У меня возникла следующая проблема. Не могу передать координаты для построения SelectionSet'а (произвольной формы). Координаты определяются на основании уже нарисованой полилинии. Вот код.
Private Sub test_Sub()
    Dim Element As Object
    Dim ssetObj1 As AcadSelectionSet
    Dim ssetObj2 As AcadSelectionSet
    Dim mode1 As Integer
    Dim mode2 As Integer
    Dim PointsArray() As Double
ZoomAll
        Set ssetObj1 = ThisDrawing.SelectionSets.Add("SelectAll_SelSet") 'Селсет всего чертежа
        mode1 = acSelectionSetAll
        ssetObj1.Select mode1
            If (ssetObj1.Count > 0) Then
                For Each Element In ssetObj1
                    If Element.Color = 42 Then
                        If Element.EntityType = acPolylineLight Then
                            PointsArray = Element.Coordinates
                            Set ssetObj2 = ThisDrawing.SelectionSets.Add("Region_SelSet") 'Селсет внутри области, ограниченной полилинией 42 цветы
                            mode2 = acSelectionSetWindowPolygon
                            ssetObj2.SelectByPolygon mode2, PointsArray() 'Здесь ошибка
                                If (ssetObj2.Count > 0) Then
                                    'Остальной код
                                End If
                        End If
                    End If
                Next Element
            End If
        ssetObj1.Delete
        ssetObj2.Delete
End Sub
Спасибо за ответ.

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: SelectByPolygon проблема с координатами

> Durimar
Проблема кроется здесь:
Element.EntityType = acPolylineLight
поскольку PointsArray() должен быть массивом
3-х мерных точек, третью координату можно
получить из свойства Elevation полилинии
Потом лучше объявить так

Option Explicit
Private Sub test_Sub()
Dim Element As AcadEntity
Dim oPline as AcadLWPolyline

а далее в теле кода:

.............
If TypeOf Element Is AcadLWPolyline Then
Set oPLine = Element
PointsArray = oPLine.Coordinates
здесь следует преобразование 2-х точек в 3-х мерные
и тд

~'J'~

  • SmeL
  • SmeL
  • Активный участник
  • Откуда: Молдова
  • На форуме с 29 сентября 2005г.
  • Сообщений: 464
  • Спасибо: 1

Re: SelectByPolygon проблема с координатами

Вот мой вариант решения этой задачи. Функция написанно только для одного типа, не было еще не обходимости ее расширять, но все в ваших силах

Public Function PlanTo3d(pl As AcadEntity)
Dim allVertex As Variant
Dim i As Integer
' On Error GoTo ENDSUB
Select Case (pl.ObjectName)
    Case "AcDbPolyline"
         allVertex = pl.Coordinates
         intTemp = UBound(pl.Coordinates)
         If pl.Closed Then
          ReDim MasVertex((intTemp + 1) / 2 * 3 + 2)
         Else
          ReDim MasVertex((intTemp + 1) / 2 * 3 - 1)
         End If
         j = 0
        For i = 0 To intTemp Step 2
         MasVertex(j) = allVertex(i) * Percent
         MasVertex(j + 1) = allVertex(i + 1)
         MasVertex(j + 2) = 0
         j = j + 3
        Next
       If pl.Closed Then
         MasVertex(j) = allVertex(0)
         MasVertex(j + 1) = allVertex(1) * Percent
         MasVertex(j + 2) = allVertex(2)
       End If
    Case Else
  End Select
 PlanTo3d = MasVertex
End Function

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

Re: SelectByPolygon проблема с координатами

"...здесь следует преобразование 2-х точек в 3-х мерные..." - спасибо Fatty!

'создание дополнительного массива содержащего теперь уже три координаты thank's to Dmitry Volkov
                        ReDim PointsArray3D((UBound(PointsArray) + 1) / 2 * 3 - 1) '- SmeL, спасибо за ReDim!
                        For i = 0 To ((UBound(PointsArray) + 1) / 2) - 1
                            PointsArray3D(i * 3) = PointsArray(i * 2)
                            PointsArray3D(i * 3 + 1) = PointsArray(i * 2 + 1)
                            PointsArray3D(i * 3 + 2) = 0
                        Next
                            Set ssetObj2 = ThisDrawing.SelectionSets.Add("Region_SelSet") 'Селсет внутри области, ограниченной полилинией 42 цветы
                            mode2 = acSelectionSetWindowPolygon
                            ssetObj2.SelectByPolygon mode2, PointsArray3D()
                                If (ssetObj2.Count > 0) Then
                                    'Остальной код
                                End If

Работает! Спасибо за помощь!

  • SmeL
  • SmeL
  • Активный участник
  • Откуда: Молдова
  • На форуме с 29 сентября 2005г.
  • Сообщений: 464
  • Спасибо: 1

Re: SelectByPolygon проблема с координатами

> Durimar
Необходимо также отслеживать полилинию на закрытость т.е. pl.Closed это влияет на количество вершин