有没有另一种方法来动态创建这个双值数组？

Question

我正在开发一个在 AutoCAD 中使用的 VBA 宏。目前它将 圆 转换为 3D 折线，并且它本身运行良好。这只是一个开始，我将能够在最后的例程中添加一些内容。

这是 VBA 宏：

 Sub CircleToPolyline()
    Dim objSel As AcadEntity
    Dim myCircle As AcadCircle
    Dim pickedPoint As Variant

    ' Get the user to select a circle
    ' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
    Call ThisDrawing.Utility.GetEntity(objSel, pickedPoint, "Select Circle:")
    If objSel.ObjectName <> "AcDbCircle" Then GoTo SKIP

    Set myCircle = objSel
    Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double

    dAngle = 0# ' We always start at 0 degrees / radians
    dAngleStep = 0.17453293 ' This is 10 degrees in radians
    dMaxAngle = 6.28318531 ' This is 360 degrees in radians
    ' So our polyline will always have 36 vertices

    Dim ptCoord() As Double
    Dim ptProject As Variant
    Dim i As Integer

    i = 0
    While dAngle < dMaxAngle
        ReDim Preserve ptCoord(0 To i + 2) ' Increase size of array to hold next vertex

        ' Calculate the next coordinate on the edge of the circle
        ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)

        ' Add to the coordinate list
        ptCoord(i) = ptProject(0)
        ptCoord(i + 1) = ptProject(1)
        ptCoord(i + 2) = ptProject(2)

        ' Increment for next coordinate/angle on the circle edge
        dAngle = dAngle + dAngleStep
        i = i + 3
    Wend

    ' Create the 3D polyline
    Dim oPolyline As Acad3DPolyline
    Set oPolyline = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
    oPolyline.Closed = True
    oPolyline.Update

SKIP:

 End Sub

我只是想知道是否有任何替代方法来管理我的动态数组 (ptCoord)？例如，有什么方法可以将ptProject 添加到动态列表中，然后在 Add3dPoly 例程中使用该列表？

问题是，PolarPoint 返回一个变体。 ptCoord 是一个 doubles 数组（这是 Add3dPoly 所期望的）。这就是我这样做的原因。我没有使用变体（除了处理返回值）。

我的代码非常简单且足够，但如果可以进一步简化，我会很想知道（考虑到 VBA 和 AutoCAD 环境的上下文）。

我希望我的问题很清楚。谢谢。

Answer 1

分配一块内存并将每个PolarPoint 调用的顺序结果写入它是可行的。然后，您可以在一次调用中将该内存复制到您的 ptCoord 数组中。但是，API 非常笨拙，会有很多摆弄指针（在 VBA 中从不简单），并且大多数内存编码错误会导致 Excel 完全崩溃。对于 108 个数据点，这似乎不值得。

我会说您迭代每个结果数组并将它们单独写入ptCoord 的想法与任何方法一样好。

你的cmets

'我们总是从 0 度/弧度开始，'所以我们的折线总是有 36 个顶点

建议您的ptCoord 数组具有固定尺寸（即36 * 3）。如果是这种情况，您不能只对数组进行一次标注吗？即使您想改变绘制的度数，您仍然可以在 (n * 3) 处对数组进行标注，而不必在每次迭代时都使用ReDim Preserve。

因此，您的代码的 sn-p 可能变为：

Dim alpha As Double
Dim index As Integer
Dim i As Integer
Dim ptCoord(0 To 107) As Double
Dim ptProject() As Double
Dim pt As Variant
...
For i = 0 To 35
    ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)
    For Each pt In ptProject
        ptCoord(index) = pt
        index = index + 1
    Next
    alpha = alpha + 0.174532925199433
Next

Answer 2

你的代码对我来说很好，我打算建议一个二维数组：-

Dim ptCoord(2,0)
...
ptCoord(0,0) = ptProject(0)
ptCoord(1,0) = ptProject(1)
ptCoord(2,0) = ptProject(2)

ReDim Preserve ptCoord(2,1)
ptCoord(0,1) = ptProject(0)
ptCoord(1,1) = ptProject(1)
ptCoord(2,1) = ptProject(2)

二维数组中的第二个维度可以动态重新维度。但我不确定这会为您节省什么，它可能不适用于Add3DPoly。

您可以使用UBound 来保存i 变量。

ReDim Preserve ptCoord(UBound(ptCoord,1)+3)

在上面我没有声明下限/基数 (0 To) 因为 0 是默认基数，然后我使用 UBound (上限) 来获取数组的大小并添加 3使其变大 3。

UBound([数组],[维度])

Array 是你要检查的数组

Dimension 是您要检查尺寸的维度，它的基数是 1 而不是 0（所以第一个维度是 1 而不是 0，第二个是 2 而不是 1，依此类推...)

您可以省略 Dimension 并假定第一个。

要在没有i 的情况下访问它，您可以使用：-

ptCoord(UBound(ptCoord,1)-2) = ptProject(0)
ptCoord(UBound(ptCoord,1)-1) = ptProject(1)
ptCoord(UBound(ptCoord,1)) = ptProject(2)

Answer 3

您可以使用AppendVertex() 方法完全跳过数组调光

Option Explicit

Sub CircleToPolyline()

    Dim myCircle As AcadCircle
    Dim circleCenter As Variant, circleRadius As Double
    Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double
    Dim oPolyline As Acad3DPolyline

    'Get the user to select a circle
    Set myCircle = GetCircle(circleCenter, circleRadius)
    If myCircle Is Nothing Then Exit Sub

    dAngle = 0# ' We always start at 0 degrees / radians
    dAngleStep = 0.17453293 ' This is 10 degrees in radians
    dMaxAngle = 6.28318531 ' This is 360 degrees in radians

    Set oPolyline = GetStarting3dPoly(circleCenter, circleRadius, dAngle, dAngleStep) ' Create the 3D polyline with first two points
    Do While dAngle + dAngleStep <= dMaxAngle
        dAngle = dAngle + dAngleStep ' Increment for next coordinate/angle on the circle edge
        oPolyline.AppendVertex ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius) 'append a new vertex
    Loop

    'finish the polyline
    oPolyline.Closed = True
    oPolyline.Update

End Sub


Function GetStarting3dPoly(circleCenter As Variant, circleRadius As Double, dAngle As Double, dAngleStep As Double) As Acad3DPolyline
    Dim ptCoord(0 To 5) As Double
    Dim ptCoords As Variant

    ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
    ptCoord(0) = ptCoords(0)
    ptCoord(1) = ptCoords(1)
    ptCoord(2) = ptCoords(2)

    dAngle = dAngle + dAngleStep
    ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
    ptCoord(3) = ptCoords(0)
    ptCoord(4) = ptCoords(1)
    ptCoord(5) = ptCoords(2)

    Set GetStarting3dPoly = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
End Function


Function GetCircle(circleCenter As Variant, circleRadius As Double) As AcadCircle
    Dim objSel As AcadEntity
    Dim pickedPoint As Variant

    ' Get the user to select a circle
    ' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
    ThisDrawing.Utility.GetEntity objSel, pickedPoint, "Select Circle:"
    If objSel.ObjectName = "AcDbCircle" Then
        Set GetCircle = objSel
        circleCenter = objSel.Center
        circleRadius = objSel.Radius
    End If
End Function

如您所见，我还从主代码中提取了一些操作并将它们限制在函数中，以便进一步增强您的代码及其功能