Gibt es eine alternative Möglichkeit, dieses Array doppelter Werte dynamisch zu erstellen?

Question

Ich entwickle ein VBA-Makro zur Verwendung in AutoCAD. Im Moment wandelt es einen Kreis in eine 3D Polylinie um und an sich funktioniert es perfekt. Es ist nur der Anfang, und ich werde in der Lage sein, etwas in die letzte Routine zu bringen.

Dies ist das Makro-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 

ich gerade frage mich, ob es alternative Methoden sind meine dynamischen Arrays für die Verwaltung (ptCoord)? Zum Beispiel gibt es eine Möglichkeit, dass ich einfach die ptProject in eine dynamische Liste hinzufügen und dann einfach diese Liste in der Add3dPoly Routine verwenden?

Die Sache ist, PolarPoint gibt eine Variante zurück. Und ptCoord ist ein Array von verdoppelt (was ist, was Add3dPoly erwartet). Deshalb habe ich es so gemacht. Ich habe keine Varianten verwendet (außer Rückgabewerte).

Mein Code ist ziemlich einfach und ausreichend, aber wenn es weiter vereinfacht werden kann, wäre ich daran interessiert zu wissen (angesichts der Kontext von VBA und AutoCAD-Umgebung).

Ich hoffe meine Frage ist klar. Vielen Dank.

Answer 1

es möglich ist, einen Teil des Speichers und schreiben die aufeinanderfolgenden Ergebnisse jeder Ihrer PolarPoint Anrufe, um es zu verteilen. Sie könnten diesen Speicher anschließend in einem einzigen Anruf in Ihr ptCoord Array kopieren. Allerdings sind die APIs sehr umständlich, es würde viel mit Zeigern herumgespielt werden (nie einfach in VBA) und die meisten Speichercodierungsfehler führen zu einem kompletten Excel-Absturz. Für 108 Datenpunkte scheint es sich nicht zu lohnen.

Ich würde sagen, Ihre Vorstellung, jedes der Ergebnis-Arrays zu iterieren und sie einzeln in ptCoord zu schreiben, ist so gut wie jeder andere.

Ihre Kommentare

'Wir sind immer bei 0 Grad/rad beginnen, und' So werden unsere Linienzug haben immer 36 Ecken

vorschlagen Ihre ptCoord Array eine feste Dimension (dh haben 36 * 3). Wenn dies der Fall ist, können Sie das Array nicht einfach einmal dimensionieren? Selbst wenn Sie die Anzahl der zu durchziehenden Graden variieren möchten, können Sie Ihr Array immer noch bei (n * 3) dimensionieren, ohne bei jeder Iteration ReDim Preserve zu haben.

konnte Ein Ausschnitt des Codes daher werden:

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

Ihr Code erscheint mir gut, ich würde eine zweidimensionale Anordnung vorzuschlagen: -

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) 

Die zweite Dimension in einer zweidimensionalen Anordnung kann dynamisch neu dimensioniert werden. Aber ich bin mir nicht sicher, dass dies Ihnen irgendetwas sparen wird und es möglicherweise nicht mit Add3DPoly funktioniert.

Sie könnten UBound verwenden, um die Variable i zu speichern.

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

In der oben habe ich nicht die untere/Base deklariert (0 To) als 0 ist die Basis Standard ist, habe ich verwenden dann UBound (Obergrenze), um die Größe der Anordnung zu erhalten und zu 3 hinzugefügt, dass um es 3 größer zu machen.

UBound ([Array], [Dimension])

Array ist das Array, das Sie auf

Dimension ist die Dimension, die Sie überprüfen möchten, um die Größe überprüfen möchten, Es hat eine Basis von 1 nicht 0 (also die erste Dimension ist 1 nicht 0, die zweite ist 2 nicht 1, und so weiter ...)

Sie können Dime weglassen nsion und die erste wird angenommen.

Um es ohne i zugreifen Sie nutzen könnten: -

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

Answer 3

Sie Arrays Dimmen insgesamt durch die Verwendung von AppendVertex() Methode

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 

wie Sie sehen, ich extrahiert überspringen können auch einige Aktionen aus dem Hauptcode und beschränkte sie in Funktionen, um den Code und seine Funktionalitäten weiter zu verbessern