有没有其他方法可以动态创建这个双值数组

Question

我正在开发一个VBA宏，用于AutoCAD。目前，它将圆转换为三维多段线，并且其本身工作非常完美。这只是一个开始，我将能够在最后的例行训练中增加一些活力。

这是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([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 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

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