是否有另一種方法來動態創建這個double值的數組？

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添加到動態列表中，然後在例程中只使用此列表？

事情是，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到使它更大。

UBound函數（[陣列]，[維度]）

陣列是要檢查

尺寸是要檢查的尺寸的尺寸的陣列，它具有1不爲0的基數（因此第一維爲1不爲0，第二維爲2不等於1，依此類推...）

您可以省略角錢nsion，首先將假定。

要訪問它，而不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 

，你看，我還提取從主代碼的一些行動並將它們限制在功能中，以便進一步提高您的代碼及其功能