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

Question

我正在开发 VBA 宏以在 AutoCAD 中使用。目前它将圆转换为 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 return 是一个变体。 ptCoord 是 doubles 的数组（这是 Add3dPoly 所期望的）。这就是我这样做的原因。我没有使用变体（除了处理 return 值）。

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

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

Answer 1

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

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)

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

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

Array 是你要检查的数组

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

您可以省略维度并且假定第一个维度。

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

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

Answer 2

分配一块内存并将每个 PolarPoint 调用的顺序结果写入其中是可行的。然后，您可以在一次调用中将该内存复制到 ptCoord 数组。但是，API 非常笨拙，需要大量修改指针（在 VBA 中从来都不是直截了当的）并且大多数内存编码错误会导致完全 Excel 崩溃。对于 108 个数据点，似乎不值得付出努力。

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

您的评论

'We always start at 0 degrees / radians, and 'So our polyline will always have 36 vertices

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

您的代码片段因此可以变成：

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 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

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

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

Is there an alternative way to dynamically create this array of double values?

vba

autocad

autocad-plugin