Modify Derived Part Example (VBA)
This example shows how to modify the parameters of a derived part.
'-----------------------------------------------
'
' Preconditions:
' (1)
Part document containing derived part feature with
' a
move feature is open.
' (2)
Derived part feature is selected.
'
' Postconditions: Parameters of the derived part feature
' and
its move feature are changed.
'
'-----------------------------------------------
Option Explicit
Function TestImportPlane(feat As Feature, doc As ModelDoc2,
comp As Component2) As Boolean
Dim
featData As SldWorks.DerivedPartFeatureData
Dim
startVal As Boolean
Dim
testVal As Boolean
Dim
boolstatus As Boolean
Set
featData = feat.GetDefinition
startVal
= featData.ImportPlane
Debug.Print
"ImportPlane = " & startVal
featData.ImportPlane = False
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
Set
featData = feat.GetDefinition
testVal
= featData.ImportPlane
If
testVal Then
featData.ImportPlane = True
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
Set
featData = feat.GetDefinition
Debug.Print
"ImportPlane = " & featData.ImportPlane
featData.ImportPlane = startVal
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
End
If
End Function
Function TestImportAbsorbedSketches(feat As Feature, doc
As ModelDoc2, comp As Component2) As Boolean
Dim
featData As SldWorks.DerivedPartFeatureData
Dim
startVal As Boolean
Dim
boolstatus As Boolean
Set
featData = feat.GetDefinition
startVal
= featData.ImportAbsorbedSketches
Debug.Print
"ImportAbsorbedSketches = " & startVal
featData.ImportAbsorbedSketches = False
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
Set
featData = feat.GetDefinition
Debug.Print
"ImportAbsorbedSketches = " & featData.ImportAbsorbedSketches
featData.ImportAbsorbedSketches = True
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
Set
featData = feat.GetDefinition
Debug.Print
"ImportAbsorbedSketches = " & featData.ImportAbsorbedSketches
featData.ImportAbsorbedSketches = startVal
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
End Function
Function TestImportUnAbsorbedSketches(feat As Feature,
doc As ModelDoc2, comp As Component2) As Boolean
Dim
featData As SldWorks.DerivedPartFeatureData
Dim
startVal As Boolean
Dim
boolstatus As Boolean
Set
featData = feat.GetDefinition
startVal
= featData.ImportUnAbsorbedSketches
Debug.Print
"ImportUnAbsorbedSketches = " & startVal
featData.ImportUnAbsorbedSketches = False
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
Set
featData = feat.GetDefinition
Debug.Print
"ImportUnAbsorbedSketches = " & featData.ImportUnAbsorbedSketches
featData.ImportUnAbsorbedSketches = True
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
Set
featData = feat.GetDefinition
Debug.Print
"ImportUnAbsorbedSketches = " & featData.ImportUnAbsorbedSketches
featData.ImportUnAbsorbedSketches = startVal
boolstatus
= feat.ModifyDefinition(featData,
doc, comp)
Set
featData = Nothing
End Function
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swComp As
SldWorks.Component2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swDerivedFeat As
SldWorks.Feature
Dim
swMoveFeat As
SldWorks.Feature
Dim
swDerivedData As
SldWorks.DerivedPartFeatureData
Dim
swMoveData As
SldWorks.MoveCopyBodyFeatureData
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
'
A derived part feature should be selected
'
(e.g., insert part, mirror part, or derived component part)
Set
swDerivedFeat = swSelMgr.GetSelectedObject6(1,
-1)
Set
swComp = swSelMgr.GetSelectedObjectsComponent3(1,
-1)
Debug.Print
"Feature = " & swDerivedFeat.Name
bRet
= TestImportPlane(swDerivedFeat, swModel, swComp)
bRet
= TestImportAbsorbedSketches(swDerivedFeat, swModel, swComp)
bRet
= TestImportUnAbsorbedSketches(swDerivedFeat, swModel, swComp)
Set
swDerivedData = swDerivedFeat.GetDefinition
Debug.Print
"Import Plane = " & swDerivedData.ImportPlane
swDerivedData.ImportPlane
= False
Debug.Print
"Import Plane = " & swDerivedData.ImportPlane
Debug.Print
"Import UnAbsorbedSketches = " & swDerivedData.ImportUnAbsorbedSketches
swDerivedData.ImportUnAbsorbedSketches
= True
Debug.Print
"Import UnAbsorbedSketches = " & swDerivedData.ImportUnAbsorbedSketches
Debug.Print
"File path = " & swDerivedData.Pathname
Set
swMoveFeat = swDerivedData.GetMoveFeature
'
For the move feature to be non-null, a move
'
should have been performed, while creating
'
the derived part
If
Not swMoveFeat Is Nothing Then
Debug.Print
"Move Feature = " & swMoveFeat.Name
Set
swMoveData = swMoveFeat.GetDefinition
Dim
count As Long
count
= swMoveData.GetBodiesCount
Debug.Print
"Number of bodies = " & count
Debug.Print
"TransformType = " & swMoveData.TransformType
Dim
tVal As Double
tVal
= swMoveData.TransformValue
Debug.Print
"Transform value = " & tVal
'
Apply changes to the move feature of the derived part
bRet
= swMoveFeat.ModifyDefinition(swMoveData,
swModel, Nothing): Debug.Assert bRet
End
If
'
Apply changes to the derived part
bRet
= swDerivedFeat.ModifyDefinition(swDerivedData,
swModel, Nothing): Debug.Assert bRet
End Sub