AnsweredAssumed Answered

API Challenge: Import Points, Create Curves, Create Lofts, Export as .step

Question asked by Joseph Johnson on Aug 14, 2015

Hello all,  I've got a challenging API to write.  I haven't seen anyone combine all of these actions into one API yet.  So far I've been able to:


  • Import all points into Solidworks
  • Create all the loft curves


Unsolved are:


  • Loft each set of curves
  • Have the loft show up in the feature manager
  • Export as .step


Here is my code for importing the points and creating the loft curves:


***************** CODE *********************


    Dim swApp        As SldWorks.SldWorks

    Dim swModel     As SldWorks.ModelDoc2

    Dim swSkMgr     As SldWorks.SketchManager

    Dim swSelMgr    As SldWorks.SelectionMgr

    Dim longstatus   As Long

    Dim boolstatus   As Boolean



Sub main()



    Dim swApp   As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2


    ' Connect to SolidWorks

    Set swApp = Application.SldWorks

    swApp.ResetUntitledCount 0, 0, 0


    ' Open new part

    Set swModel = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2012\templates\Part.prtdot", 0, 0, 0)

    swApp.ActivateDoc2 "Part1", False, longstatus


    ' Get active document

    Set swModel = swApp.ActiveDoc


    ' Get SketchManager

    Set swSkMgr = swModel.SketchManager

    swSkMgr.InsertSketch True

    boolstatus = swModel.Extension.SelectByID2("Top Plane", "PLANE", -5.53489443349025E-02, 3.30468607538553E-03, 2.69617286188933E-02, False, 0, Nothing, 0)


    ' Clear the selection

    swModel.ClearSelection2 True


    ' Check whether document is active

    If swModel Is Nothing Then

        swApp.SendMsgToUser2 "A part document must be active.", swMbWarning, swMbOk

        Exit Sub

    End If


    ' Check whether document is a part

    Dim modelType As Long

    modelType = swModel.GetType


    'Throw error if not a part document

    If modelType <> SwConst.swDocPART Then

        swApp.SendMsgToUser2 "A part document must be active.", swMbWarning, swMbOk

        Exit Sub

    End If


    'Sets index as an integer type, path as string, ext as string, filename as string

    Dim index          As Integer

    Const path         As String = "H:\ContourPoints\contour_points"

    Const ext           As String = ".txt"

    Dim filename     As String


    'Set the number of shapes present

    Dim shapes As Integer


    'Number of shapes and number of contours

    shapes = 12

    contour = 36


    'Indexes through all files and inserts a curve based on each text file's [x y z] points

    For index = 1 To contour


     filename = path + CStr(index) + ext

     value = swModel.InsertCurveFile(filename)


    Next index


    ' Sketch is exited

    swModel.InsertSketch2 True


****************** END CODE ************************


This code gets me to the point where I can see this one my screen:  import points are:

  • Generates 30+ curves NOT in a sketch (this is OK)
  • I end up opening a sketch, not using the sketch, then closing the sketch
    • Not a big deal, but a small fix suggestion would be great




Now comes the hard part.  I want to select each set of 3 and create a close loft.  Systematically picking the curves is not a big deal, but creating the loft has been really tricky.  Here's what I've tried:




   Set swSelMgr = swModel.SelectionManager


    'Selecting Curves

    boolstatus = swModel.Extension.SelectByID2("Curve10", "REFCURVE", 0, 0, 0, False, 0, Nothing, 0)

    boolstatus = swModel.Extension.SelectByID2("Curve22", "REFCURVE", 0, 0, 0, False, 1, Nothing, swSelectOptionDefault)

    boolstatus = swModel.Extension.SelectByID2("Curve34", "REFCURVE", 0, 0, 0, False, 1, Nothing, swSelectOptionDefault)


    'Create Loft:

        swModel.InsertLoftRefSurface2 False, False, False, 1, 0, 0


What this code does is select 3 (correct) curves, but then when I call the InsertLoftRefSurface2, nothing happens.  I thought "oh maybe this is because I'm not creating a loft through splines / random curves, when I actually want a lofted shape"


So then I  moved on to an example found in help called CreateLoftBody2


******* CODE START ********


Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swFeatMgr As SldWorks.FeatureManager

Dim count As Long

Dim featArr As Variant

Dim feat1 As SldWorks.Feature

Dim feat2 As SldWorks.Feature

Dim feat3 As SldWorks.Feature

Dim swSelMgr As SldWorks.SelectionMgr

Dim swModeler As SldWorks.Modeler

Dim boolstatus As Boolean

Dim profileIn As Variant

Dim guideCurve As Variant

Dim pProfile(2) As SldWorks.Feature

Dim pGuide(0) As SldWorks.Feature

Dim bValue As Boolean

Dim swBody As SldWorks.Body2

Dim bIsTempBody As Boolean


Sub main()


Set swApp = Application.SldWorks


Set swModeler = swApp.GetModeler

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension


' Select the sketches for the profiles

' for the loft body and make them

' elements of an array to use to

' create the loft body


Set swFeatMgr = swModel.FeatureManager

count = swFeatMgr.GetFeatureCount(False)

featArr = swFeatMgr.GetFeatures(False)

Set swSelMgr = swModel.SelectionManager


'Gets first curve and puts it in profile array

boolstatus = swModelDocExt.SelectByID2("Curve8", "REFCURVE", 0, 0, 0, False, 0, Nothing, 0)

Set feat1 = swSelMgr.GetSelectedObject6(1, -1)

Debug.Print "First profile's feature name:       " & feat1.Name

Set pProfile(0) = feat1


'Gets second curve and puts it in profile array

boolstatus = swModelDocExt.SelectByID2("Curve20", "REFCURVE", 0, 0, 0, False, 0, Nothing, 0)

Set feat2 = swSelMgr.GetSelectedObject6(1, -1)

Debug.Print "Second profile's feature name:      " & feat2.Name

Set pProfile(1) = feat2


'Gets third curve and puts it in profile array

boolstatus = swModelDocExt.SelectByID2("Curve32", "REFCURVE", 0, 0, 0, False, 0, Nothing, 0)

Set feat3 = swSelMgr.GetSelectedObject6(1, -1)

Debug.Print "Third profile's feature name:      " & feat3.Name

Set pProfile(2) = feat3

profileIn = pProfile


'''''No guide curve'''''''

' Select a guide curve for the loft body

' and make it an element of an array

' to use to create the loft body

'boolstatus = swModelDocExt.SelectByID2("Curve1", "REFERENCECURVES", 0.1353192072154, 0.1043159291966, 0.09477145953832, False, 0, Nothing, 0)

'Set feat3 = swSelMgr.GetSelectedObject6(1, -1)

'Debug.Print "Guide curve's feature name:         " & feat3.Name

'Set pGuide(0) = feat3

'guideCurve = 0



' Create the loft body

Set swBody = swModeler.CreateLoftBody2(swModel, profileIn, Nothing, Nothing, False, 0, 0, 0, True, False, False, False, True, 0, 0, 0, False, True, 0, 0, False)




' Test whether the loft body is a temporary body

bIsTempBody = swBody.IsTemporaryBody

Debug.Print "Is the loft body a temporary body?  " & bIsTempBody


' Display the loft body

bValue = swBody.Display3(swModel, RGB(50, 100, 160), swTempBodySelectOptionNone)



End Sub


*************************** End Code ************************


This code gets me a little further, for example the picture below




But there are a few things wrong with this:

  1. I don't see this loft in the featureManager
  2. It is not selectable
  3. It looks like it needs a guide curve as the tangencies are all messed up, as the shape should not look ribbed.  Doing a simple loft feature without the API gives me the correct shape and it shows up in the featuremanager Tree (see below)




Is there any easy way to fix the without a guide curve to make the shape on the right look like the shape on the left?  Is CreateLoftBody2 what I should be using?


Then the outstanding issues are:

  1. How do I make this show up in the featuremanager?
  2. How do I make the loft on the right selectable and look like the one on the left?
  3. How do I export as .step?


Here is a bit of code I found that ( I think ) turns a surface body into a sheet body and puts it into the feature manager.  But I am not creating a sheet body, so doesn't help, but might spark an idea in someone...


If (Not (swBody Is Nothing)) Then

        ' Turn loft surface body into a sheet body

        Debug.Assert (swBody.GetType = swBodyType_e.swSheetBody)

        Debug.Print "#faces = " & swBody.GetFaceCount

       ' Turn sheet body into a feature

        vFeatures = swPart.CreateSurfaceFeatureFromBody(swBody, swCreateFeatureBodyOpts_e.swCreateFeatureBodyCheck)

        Debug.Assert (Not IsEmpty(vFeatures))


       ' Update the FeatureManager design tree



        ' Update graphics




    End If



Thanks for reading!