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:
InsertLoftRefSurface2
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:
- I don't see this loft in the featureManager
- It is not selectable
- 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:
- How do I make this show up in the featuremanager?
- How do I make the loft on the right selectable and look like the one on the left?
- 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
swModel.EditRebuild3
' Update graphics
swModel.ViewZoomtofit2
swModel.Create
End If
Thanks for reading!