Draw a new Profile from an Existing Profile In AutoCAD Using VBA

I am using AutoCad 2021 and I want to create a new profile from an existing profile, starting 25 cm below the existing profile, continuing with 1% slope until it intersects the existing profile, then dropping vertically 25 cm and continuing with 1% slope until it intersects the existing profile, then repeating until the end of the existing profile.

I have the below VBA code which continually gives me the error on line "newProfile.AddVertex" as wrong number of arguments or invalid property assignment. I would highly appreciate any suggestion to review my code to make it work.

Sketch of Automatization I am trying in VBA

Sub CreateNewProfile()
    Dim obj As AcadObject
    Dim existingProfile As AcadLWPolyline
    Dim newProfile As AcadLWPolyline
    Dim startPoint As Variant, endPoint As Variant
    Dim elevationChange As Double
    Dim slope As Double
    
    ' Set the elevation change and slope
    elevationChange = 25 ' in cm
    slope = 0.01 ' 1% slope
    
    ' Select the existing profile
    Set existingProfile = ThisDrawing.Utility.GetObject(, "Select existing profile:")
    
    ' Create a new profile
    Set newProfile = ThisDrawing.ModelSpace.AddLightWeightPolyline(existingProfile.Coordinates)
    
    ' Loop through each segment of the existing profile
    For i = 1 To existingProfile.NumberOfVertices - 1
        startPoint = existingProfile.Coordinates(i)
        endPoint = existingProfile.Coordinates(i + 1)
        
        ' Calculate the length and direction of the segment
        length = Sqr((endPoint(0) - startPoint(0)) ^ 2 + (endPoint(1) - startPoint(1)) ^ 2)
        angle = Atn((endPoint(1) - startPoint(1)) / (endPoint(0) - startPoint(0)))
        
        ' Create the new segments with the specified elevation change and slope
        newProfile.AddVertex startPoint(0), startPoint(1), startPoint(2) - elevationChange
        
        ' Calculate the endpoint of the first slope segment
        newX = startPoint(0) + (elevationChange / slope) * Cos(angle)
        newY = startPoint(1) + (elevationChange / slope) * Sin(angle)
        newProfile.AddVertex newX, newY, startPoint(2) - elevationChange
        
        ' Add the next vertex on the existing profile
        newProfile.AddVertex endPoint(0), endPoint(1), endPoint(2) - elevationChange
        
        ' Continue until the end of the existing profile
        If i < existingProfile.NumberOfVertices - 1 Then
            ' Calculate the endpoint of the vertical drop
            newX = endPoint(0) + elevationChange * Cos(angle)
            newY = endPoint(1) + elevationChange * Sin(angle)
            newProfile.AddVertex newX, newY, endPoint(2)
        End If
    Next i
    
    ' Close the new profile
    newProfile.Closed = True
    
    MsgBox "New profile created successfully!"
End Sub

Your code doesn't seem to match your wording, which I take as giving the right info

First off the "wrong number of arguments or invalid property assignment" error is due to your not matching the AddVertex() method "signature" which requires a "Long" and then a "three-element array of doubles" parameter

Then you should review the actual result of Coordinates property for a LightWeight Polyline object which returns "an array of 2D points"

I hope the following can give you a good starting point

Option Explicit

Sub CreateNewProfile()

    On Error GoTo SafeExit
    
    ' Set the elevation change and slope
    Dim elevationChange As Double
        elevationChange = 25 ' in cm
    
    Dim slope As Double
        slope = 0.01 ' 1% slope
    
    ' Select the existing profile
    Dim existingProfile As AcadLWPolyline
        Dim basePnt As Variant
        ThisDrawing.Utility.GetEntity existingProfile, basePnt, "Select existing profile:"
    
    Dim nVertices As Long
        nVertices = 1 '(UBound(existingProfile.Coordinates) + 1) / 2
        
    ' Create a new profile
    Dim newProfile As AcadLWPolyline
        Set newProfile = ThisDrawing.ModelSpace.AddLightWeightPolyline(existingProfile.Coordinates)
    
        'set the starting point coordinates
        Dim x As Double, _
            y As Double
            x = existingProfile.Coordinates(0)
            y = existingProfile.Coordinates(1)
        
        Dim iVertex As Long
            iVertex = nVertices - 1
        
        'add the the starting point vertex
        Dim newVertex(0 To 1) As Double
            newVertex(0) = x: newVertex(1) = y
            iVertex = iVertex + 1
            newProfile.AddVertex iVertex, newVertex
            
        'update the new starting point coordinates
        y = y - elevationChange
        
        'add the new starting point as a new vertex
        newVertex(1) = y
        iVertex = iVertex + 1
        newProfile.AddVertex iVertex, newVertex
            
            Dim okLoop As Boolean
                Do
                    ' Create a temporary helper line to intersect with the existing polyline
                    Dim startPt(0 To 2) As Double
                    Dim endPt(0 To 2) As Double
                        startPt(0) = x: startPt(1) = y: startPt(2) = 0
                        endPt(0) = x + 10: endPt(1) = y + slope * 10: endPt(2) = 0
                    Dim lineObj As AcadLine
                        Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
                
                    ' Find the intersection points between the line and the circle
                    Dim intPoints As Variant
                        intPoints = lineObj.IntersectWith(existingProfile, acExtendThisEntity)
                    
                    ' look for any valid intersections
                    Select Case True
                    
                        Case VarType(intPoints) = vbEmpty
                            lineObj.Delete
                            Exit Do
                            
                        Case UBound(intPoints) = -1
                            lineObj.Delete
                            Exit Do
                            
                        Case Else ' there is a valid intersection
                            
                            ' add the intersection as the new vertex
                            newVertex(0) = intPoints(0): newVertex(1) = intPoints(1)
                            iVertex = iVertex + 1
                            newProfile.AddVertex iVertex, newVertex
                            
                            'delete the temporary helper line
                            lineObj.Delete
                            
                            'update the new starting point coordinates
                            x = newVertex(0)
                            y = newVertex(1) - elevationChange
                            
                            ' add the new starting point as a new vertex
                            newVertex(1) = y
                            iVertex = iVertex + 1
                            newProfile.AddVertex iVertex, newVertex
                            
                    End Select
                
                Loop While True
    
    newProfile.Closed = False
    
SafeExit:
    If Err.Number <> 0 Then
        MsgBox Err.Description
    Else
        MsgBox "New profile created successfully!"
    End If
End Sub