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 是双打的数组（这是 Add3dPoly 所期望的）。这就是我这样做的原因。我没有使用变体（处理返回值除外）。

我的代码非常简单和充足，但如果可以进一步简化，我会有兴趣知道（考虑到VBA和AutoCAD环境的背景）。

我希望我的问题很明确。谢谢。

Answer 1

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

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

您的意见

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

建议您的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 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函数（ [阵列] ， [维度] ）

数组是您要检查的数组

尺寸是要检查尺寸的尺寸，它的基数为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 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

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

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

3 个答案: