Heya;

Facing an interesting challenge; I have a series of 3D spline curves that I need to turn into a series of lofts. Each loft is between two adjacent curves in the series. I have code that generates over a thousand curves which I can load using the ScanTo3D utility. I can then manually create each loft, but given the snail-like performance when the massive amount of data is present, it takes an unreasonable amount of to do it by hand.

So, I figure its high time to jump into the world of writing macros! I have yet to find one that does this task.

From mucking about, I have code that kind of works, in that it selects the curves in the correct order. However, I have so far been unsucessful in creating a loft feature. Has anyone created surface lofts or similar features before? I am sure its something obvious that I am missing, but I am not familiar with either VBA or the Solidworks API...

Attached is part with a few curves as a generic representation of the problem, as well as the code I have so far. The code has two sections, one that uses InsertLoftRefSurface2 and one that uses CreateLoftSurface. Neither one works. Currently just attempting one loft operation, will expand it to the full series once that is working. Any ideas or pointers?

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swSketch As SldWorks.Sketch
Dim vSegs As Variant
Dim vSeg As Variant
Dim swSeg As SldWorks.SketchSegment
Dim swModel As Object
Sub main()
    ' Initialize Solidworks objects
    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    Set swSketch = swDoc.SketchManager.ActiveSketch
    Set swModel = swApp.ActiveDoc
    Dim swSelMgr As SldWorks.SelectionMgr
    Set swSelMgr = swModel.SelectionManager
    ' Throw an error & exit if not in sketch
    If swSketch Is Nothing Then
        MsgBox "No sketch active!"
        Exit Sub
    End If
    ' Clear selection & get segments from sketch
    swDoc.ClearSelection2 True
    vSegs = swSketch.GetSketchSegments
    ' Create points from beginnings of spline curves
    Dim Curve As Object
    Dim PointsObject As Variant
    Dim LocStart0 As Object
    Dim LocStart1 As Object
    Dim boolstatus As Boolean
    ' Select curve 0
    Set Curve = vSegs(0).GetCurve()
    PointsObject = Curve.Evaluate(0)
    Set LocStart0 = swDoc.CreatePoint2(PointsObject(0), PointsObject(1), PointsObject(2))
    boolstatus = swModel.Extension.SelectByID2("", "SKETCHSEGMENT", PointsObject(0), PointsObject(1), PointsObject(2), False, 1, Nothing, 1)
    ' Select curve 1
    Set Curve = vSegs(1).GetCurve()
    PointsObject = Curve.Evaluate(0)
    Set LocStart1 = swDoc.CreatePoint2(PointsObject(0), PointsObject(1), PointsObject(2))
    boolstatus = swModel.Extension.SelectByID2("", "SKETCHSEGMENT", PointsObject(0), PointsObject(1), PointsObject(2), True, 1, Nothing, 1)
    ' Create surface loft
    swModel.InsertLoftRefSurface2 False, True, False, 1, 0, 0
    ' variables for CreateLoftSurface
    Dim swModeler As IModeler
    Dim CurveArray(2) As Object
    Dim BBlendClosed As Boolean
    Dim BForceCubic As Boolean
    Dim GuideCrvArray As Object
    Dim StartMatchingType As Integer
    Dim EndMatchingType As Integer
    Dim NormalAtStartSection As Object
    Dim NormalAtEndSection As Object
    Dim StartMatchingFaceList As Object
    Dim EndMatchingFaceList As Object
    Dim DegeneratedStart As Boolean
    Dim DegeneratedEnd As Boolean
    Dim StartPointOfStartSection As Object
    Dim StartPointOfEndSection As Object
    Dim SectionIndexStart As Integer
    Dim SectionIndexEnd As Integer
    Dim GuideIndexStart As Integer
    Dim GuideIndexEnd As Integer
    Dim LoftSurface As Object
    Set CurveArray(0) = vSegs(0)    ' Sets first curve
    Set CurveArray(1) = vSegs(1)    ' Sets second curve
    BBlendClosed = False            ' False for non-closed
    BForceCubic = False             ' False for not forcing cubic surface
    Set GuideCrvArray = Nothing     ' Don't have a guide curve
    StartMatchingType = 0           ' Match none
    EndMatchingType = 0             ' Match none
    Set NormalAtStartSection = Nothing  ' Not used
    Set NormalAtEndSection = Nothing    ' Not used
    Set StartMatchingFaceList = Nothing ' Not used
    Set EndMatchingFaceList = Nothing   ' Not used
    DegeneratedStart = False            ' Not used
    DegeneratedEnd = False              ' Not used
    Set StartPointOfStartSection = LocStart0    'Start point of curve 0
    Set StartPointOfEndSection = LocStart1      'Start point of curve 1
    SectionIndexStart = 0
    SectionIndexEnd = 1
    GuideIndexStart = -1
    GuideIndexEnd = -1
    ' Create the surface loft
    Set swModeler = swApp.GetModeler
    Set LoftSurface = swModeler.CreateLoftSurface(CurveArray, BBlendClosed, BForceCubic, GuideCrvArray, StartMatchingType, EndMatchingType, NormalAtStartSection, NormalAtEndSection, StartMatchingFaceList, EndMatchingFaceList, DegeneratedStart, DegeneratedEnd, StartPointOfStartSection, StartPointOfEndSection, SectionIndexStart, SectionIndexEnd, GuideIndexStart, GuideIndexEnd)
End Sub