Loft using profiles in the same 3D sketch - using VBA

aeronRQG8R · ‎07-11-2024

Hello people.
I am trying to do a VBA code to automate the following steps:
1- import an excel spreadsheet points to a 3d sketch and generate some splines passing through the points that are in the same section. After that I close the spline with a straight line.

2- use the closed sections generated by spline+line in each section to be loft profiles.

Step 1 is working, but step 2 isn't. I will attach my code here. I could create the profiles and everything, but it ends up in an error with the last loft command (line 111). Code is below:

Sub testing()
    Dim invApp As Inventor.Application
    Set invApp = ThisApplication

    ' Open new part document
    Dim invDoc As Inventor.PartDocument
    Set invDoc = invApp.Documents.Add(kPartDocumentObject, invApp.FileManager.GetTemplateFile(kPartDocumentObject))
    
    Dim CompDef As PartComponentDefinition
    Set CompDef = invDoc.ComponentDefinition
    
    ' Start new 3D Sketch
    Dim inv3DSketch As Inventor.Sketch3D
    Set inv3DSketch = invDoc.ComponentDefinition.Sketches3D.Add
    
    ' Address of the spreadsheet with data
    Dim filePath As String
    filePath = "C:\Path\to\your\output.xlsx" ' Update with your generic output file path
    
    ' Create and manipulate Excel object
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWs As Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Open(filePath)
    Set xlWs = xlWb.Sheets(1)
    
    xlApp.Visible = False
    
    ' Read points from Excel
    Dim row As Integer
    row = 1
    
    Dim firstPoint As Variant
    Dim currentPoint As Variant
    Dim pointsColl As ObjectCollection
    Set pointsColl = invApp.TransientObjects.CreateObjectCollection
    Dim flag As Integer
    Dim sections As ObjectCollection
    Set sections = invApp.TransientObjects.CreateObjectCollection
    
    inv3DSketch.Edit
    
    Do While xlWs.Cells(row, 1) <> ""
        flag = 0
        ' Save current point
        pointX = xlWs.Cells(row, 1)
        pointY = xlWs.Cells(row, 2)
        pointZ = xlWs.Cells(row, 3)
        Set currentPoint = invApp.TransientGeometry.CreatePoint(CDbl(pointX) * 100, CDbl(pointY) * 100, CDbl(pointZ) * 100) ' Unit conversion
        
        ' Set initial point if starting a new section
        If IsEmpty(firstPoint) Then
            Set firstPoint = currentPoint
            flag = 1
        End If
        
        ' Save current point in collection if not first or last point
        If flag = 1 Or (currentPoint.X = firstPoint.X And currentPoint.Y = firstPoint.Y And currentPoint.Z = firstPoint.Z And pointsColl.Count > 0) Then
            ' Ignore first and last point
        Else
            pointsColl.Add currentPoint
        End If
        
        If currentPoint.X = firstPoint.X And currentPoint.Y = firstPoint.Y And currentPoint.Z = firstPoint.Z And flag <> 1 Then
            ' Remove first 15 and last 15 points
            If pointsColl.Count > 30 Then
                Dim tempColl As ObjectCollection
                Set tempColl = invApp.TransientObjects.CreateObjectCollection
                Dim i As Integer
                For i = 16 To pointsColl.Count - 15
                    tempColl.Add pointsColl.Item(i)
                Next i
                Set pointsColl = tempColl
            End If
            
            ' Add line connecting new first to new last point
            If pointsColl.Count > 1 Then
                Dim newFirstPoint As Point
                Dim newLastPoint As Point
                Set newFirstPoint = pointsColl.Item(1)
                Set newLastPoint = pointsColl.Item(pointsColl.Count)
                Dim line As SketchLine3D
                Set line = inv3DSketch.SketchLines3D.AddByTwoPoints(newFirstPoint, newLastPoint)
            End If
            
            ' Create spline
            Dim spline As Inventor.SketchSpline3D
            Set spline = inv3DSketch.SketchSplines3D.Add(pointsColl)
            
            ' Create a profile for each closed section and add to sections collection
            Dim Profile As Profile3D
            Set Profile = inv3DSketch.Profiles3D.AddOpen
            sections.Add Profile
            
            ' Clear for next section
            firstPoint = Empty
            pointsColl.Clear
            
            flag = 0
        End If
        
        row = row + 1
    Loop
    
    inv3DSketch.ExitEdit
    
    ' Create loft surface using profiles
    Dim LoftDef As LoftDefinition
    Set LoftDef = CompDef.Features.LoftFeatures.CreateLoftDefinition(sections, kSurfaceOperation)
    CompDef.Features.LoftFeatures.Add LoftDef
    
    ' Close Excel without saving
    xlWb.Close False
    Set xlWb = Nothing

    ' Quit Excel
    xlApp.Quit
    Set xlApp = Nothing
    
    MsgBox "Done!"
End Sub

.
What I want is to import some sections and use to create a loft, like a variable diameter (or shape) pipeline. Hope someone could help me.
Thank you.