Create Loft Body Example (VBA)
This example shows how to create a loft body using IModeler::CreateLoftBody2.
' ******************************************************************************
' Preconditions:
' (1)
Part document is open.
' (2)
Two closed sketches representing the profiles for the loft body exist.
' (3)
One curve representing a guide curve for the loft body exists.
'
' Postconditions: Loft body is created and displayed.
' ******************************************************************************
Option Explicit
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(1) 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
boolstatus = swModelDocExt.SelectByID2("Sketch1",
"SKETCH", 0.01432052560262, 0.03232526173853, 0, False, 0, Nothing,
0)
Set feat1 = swSelMgr.GetSelectedObject6(1,
-1)
Debug.Print "First profile's feature name: "
& feat1.Name
Set pProfile(0) = feat1
boolstatus = swModelDocExt.SelectByID2("Sketch2",
"SKETCH", 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
profileIn = pProfile
' 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
Set guideCurve = feat3
' Create the loft body
Set swBody = swModeler.CreateLoftBody2(swModel,
profileIn, guideCurve, Nothing, False, 0, 0, 0, True, False, True, False,
True, 1, 1, 1, True, True, 1, 1, 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,
256, swTempBodySelectOptionNone)
End Sub