在 AutoCAD vba 中出现数组错误。下标超出范围

Question

我正在尝试创建代码来选择多边形并告诉它包含什么，即 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

Answer 1

您的代码中的主要问题是您没有按照 AutoCAD 对象 nmodel 正确处理两个数组的正确和不同维度

1) LWPolyline Coordinates 属性为 LWPolylines 返回一个“OCS 中的二维点数组”

2) SelectByPolygon 方法接受一个“双精度三元素数组”

在以下代码中，您可以看到已修复的这些问题以及与 SelectionSet 对象的设置和使用有关的其他一些概念缺陷（请参阅解释性 cmets）：

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 代码块包装在特定函数中，以避免重复代码，更好地维护它，并希望可以重用它，例如：

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"

而不是那些每个包含五个语句的代码块