получение ошибки массива в autocad vba. индекс вне диапазона - PullRequest
Новая
       90

получение ошибки массива в autocad vba. индекс вне диапазона

0 голосов
/ 07 апреля 2020

Я пытаюсь создать код, который выбирает многоугольники и говорит, что он содержит, например, mtext. но я получаю сообщение об ошибке, в то время как Redim массив.

ниже код для этого. его дающий индекс 

Sub polycoords()
   Dim objSSet As AcadSelectionSet, a As AcadLWPolyline, objSSet1 As AcadSelectionSet, a1 As AcadMText, pointsArray() As Double, j As Integer, i As Integer
    Dim lngMode As Long, cc As Integer
    If Not objSSet Is Nothing Then
        objSSet.Delete
     End If
    Set objSSet = ThisDrawing.SelectionSets.Add("443t39cr2t")

    objSSet.SelectOnScreen

     For Each a In objSSet



         ReDim pointsArray(0 To UBound(a.Coordinates) + UBound(a.Coordinates) / 2)
         j = 0
         For i = 0 To UBound(a.Coordinates) + UBound(a.Coordinates) / 2 Step 2
             pointsArray(j) = a.Coordinates(i)
             j = j + 1
             pointsArray(j) = a.Coordinates(i)
             j = j + 1
             pointsArray(j) = a.Coordinates(i)
             j = j + 1
         Next i

               Set objSSet1 = ThisDrawing.SelectionSets.Add("g44c3rt2it")
               lngMode = acSelectionSetWindowPolygon

               objSSet1.SelectByPolygon lngMode, pointsArray
              For Each a1 In objSSet1
                  Debug.Print a1.TextString
              Next a1

         Debug.Print vbNewLine

         On Error Resume Next
     Next a
     If Not objSSet Is Nothing Then
        objSSet.Delete
     End If


End Sub

1 Ответ

1 голос
/ 07 апреля 2020

основная проблема в вашем коде заключается в том, что вы неправильно обрабатываете правильные и разные размеры двух массивов в соответствии с nmodel объекта * AutoCAD

1) LWPolyline Coordinates свойство возвращает "массив 2D точек в OCS" для LWPolylines

2) SelectByPolygon метод принимает "трехэлементный массив двойников"

В следующем коде вы можете увидеть эти проблемы, исправленные вместе с некоторыми другими стандартными fl aws, касающимися установки и использования SelectionSet объектов (см. Пояснительные комментарии): 

Sub PolyCoords()
    Dim objSSet As AcadSelectionSet, objSSet1 As AcadSelectionSet
    Dim a As AcadEntity, a1 As AcadEntity ' you never know what the user is going to actually select, so use a "generic" type
    Dim myLWPoly As AcadLWPolyline ' use a specifically typed variable for the wanted object
    Dim pointsArray() As Double
    Dim j As Long, i As Long, lngMode As Long ' get in the habit of always using 'Long' type instead of 'Integer', to avoid overflow errors (integers reaches up to some 32 thousands)

    On Error Resume Next
    Set objSSet = ThisDrawing.SelectionSets("443t39cr2t") ' try gettin the selection set named after "443t39cr2t"
    On Error GoTo 0
    If objSSet Is Nothing Then Set objSSet = ThisDrawing.SelectionSets.Add("443t39cr2t") ' if unsuccessful (i.e. there was no such SSet named after "443t39cr2t") then create it
    objSSet.Clear ' clear the selectionset

    objSSet.SelectOnScreen

    Dim nVert As Long ' variable to hold LWPlyline number of vertices
    lngMode = acSelectionSetWindowPolygon ' set 'SelectByPolygon' 'Mode' parameter using 'AcSelect' enumeration value
    For Each a In objSSet
        If TypeOf a Is AcadLWPolyline Then ' if current object in selectionset is a LWPolyline
            Set myLWPoly = a
            nVert = (UBound(myLWPoly.Coordinates) + 1) / 2 ' get the number of its vertices: for LWPolylines coordinates returns an "array of 2D points in OCS"
            ReDim pointsArray(0 To nVert * 3 - 1) ' dim the array for 'SelectByPolygon': it accepts a "three-element array of doubles"
            j = 0
            For i = 0 To nVert - 1
                pointsArray(j) = myLWPoly.Coordinates(i)
                j = j + 1
                pointsArray(j) = myLWPoly.Coordinates(i + 1)
                j = j + 1
                pointsArray(j) = 0 ' 3rd coordinate must be zero, since LWPolyline is a 2D element
                j = j + 1
            Next

            On Error Resume Next
            Set objSSet1 = ThisDrawing.SelectionSets("g44c3rt2it") ' try gettin the selection set named after "443t39cr2t"
            On Error GoTo 0
            If objSSet1 Is Nothing Then Set objSSet1 = ThisDrawing.SelectionSets.Add("g44c3rt2it") ' if unsuccessful (i.e. there was no such SSet named after "443t39cr2t") then create it
            objSSet1.Clear ' clear the selectionset

            objSSet1.SelectByPolygon lngMode, pointsArray
            For Each a1 In objSSet1
                If TypeOf a1 Is AcadText Or TypeOf a1 Is AcadMText Then Debug.Print a1.TextString ' if current item in selectionset is a TEXT or MTEXT then type its text
            Next
            objSSet1.Clear ' clear the selectionset for subsequent use

            Debug.Print vbNewLine
        End If

    Next

End Sub

конечно, вы можете решить обернуть блок кода SelectionSet в определенную функцию c, чтобы избежать дублирования кода, лучше поддерживать его и, надеюсь, использовать его повторно, например: 

Function GetOrSetSelectionSet(ssetname As String) As AcadSelectionSet
    Dim objSSet As AcadSelectionSet

    On Error Resume Next
    Set objSSet = ThisDrawing.SelectionSets(ssetname) ' try gettin the selection set named after passed variable 'ssetname'
    On Error GoTo 0
    If objSSet Is Nothing Then Set objSSet = ThisDrawing.SelectionSets.Add(ssetname) ' if unsuccessful (i.e. there was no such SSet named after passed variable 'ssetname') then create it
    objSSet.Clear ' clear the selectionset

    Set GetOrSetSelectionSet = objSSet ' return the selectionset object
End Function

для использования в вашем основном коде как: 

Set objSSet = GetOrSetSelectionSet("443t39cr2t") ' get or set a cleared selection set named after "443t39cr2t"

и 

Set objSSet1 = GetOrSetSelectionSet("g44c3rt2it") ' get or set a cleared selection set named after "g44c3rt2it"

вместо тех блоков кода по пять операторов каждый

...