Traverse Assembly and Hide All Sketches Example (VBA)
This example shows how to traverse an assembly and hide all sketches.
'------------------------------------------------------------------
'
' Preconditions: An assembly is open.
'
' Postconditions: All sketches in the assembly are hidden.
'
'------------------------------------------------------------------
Option Explicit
Sub BlankSketchFeature _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swFeat
As SldWorks.feature _
)
Dim
bRet As
Boolean
If
"ProfileFeature" = swFeat.GetTypeName
Then
bRet
= swFeat.Select2(False, 0): Debug.Assert
bRet
swModel.BlankSketch
End
If
End Sub
Sub TraverseFeatureFeatures _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swFeat
As SldWorks.feature, _
nLevel
As Long _
)
Dim
swSubFeat As
SldWorks.feature
Dim
swSubSubFeat As
SldWorks.feature
Dim
swSubSubSubFeat As
SldWorks.feature
Dim
sPadStr As
String
Dim
i As
Long
For
i = 0 To nLevel
sPadStr
= sPadStr + " "
Next
i
Dim
bRet As Boolean
If
"Annotations" <> swFeat.Name
Then
bRet
= swFeat.Select2(True, 0): Debug.Assert
bRet
End
If
While
Not swFeat Is Nothing
Debug.Print
sPadStr + swFeat.Name + "
[" + swFeat.GetTypeName +
"]"
BlankSketchFeature
swApp, swModel, swFeat
Set
swSubFeat = swFeat.GetFirstSubFeature
While
Not swSubFeat Is Nothing
Debug.Print
sPadStr + " "
+ swSubFeat.Name + " ["
+ swSubFeat.GetTypeName + "]"
BlankSketchFeature
swApp, swModel, swSubFeat
Set
swSubSubFeat = swSubFeat.GetFirstSubFeature
While
Not swSubSubFeat Is Nothing
Debug.Print
sPadStr + " "
+ swSubSubFeat.Name + " ["
+ swSubSubFeat.GetTypeName + "]"
BlankSketchFeature
swApp, swModel, swSubSubFeat
Set
swSubSubSubFeat = swSubFeat.GetFirstSubFeature
While
Not swSubSubSubFeat Is Nothing
Debug.Print
sPadStr + " "
+ swSubSubSubFeat.Name + "
[" + swSubSubSubFeat.GetTypeName
+ "]"
BlankSketchFeature
swApp, swModel, swSubSubSubFeat
Set
swSubSubSubFeat = swSubSubSubFeat.GetNextSubFeature()
Wend
Set
swSubSubFeat = swSubSubFeat.GetNextSubFeature()
Wend
Set
swSubFeat = swSubFeat.GetNextSubFeature()
Wend
Set
swFeat = swFeat.GetNextFeature
Wend
End Sub
Sub TraverseComponentFeatures _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swComp
As SldWorks.Component2, _
nLevel
As Long _
)
Dim
swFeat As
SldWorks.feature
Set
swFeat = swComp.FirstFeature
TraverseFeatureFeatures
swApp, swModel, swFeat, nLevel
End Sub
Sub TraverseComponent _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swComp
As SldWorks.Component2, _
nLevel
As Long _
)
Dim
vChildComp As
Variant
Dim
swChildComp As
SldWorks.Component2
Dim
swCompConfig As
SldWorks.Configuration
Dim
sPadStr As
String
Dim
i As
Long
For
i = 0 To nLevel - 1
sPadStr
= sPadStr + " "
Next
i
vChildComp
= swComp.GetChildren
For
i = 0 To UBound(vChildComp)
Set
swChildComp = vChildComp(i)
Debug.Print
sPadStr & "+" & swChildComp.Name2
& " <" & swChildComp.ReferencedConfiguration
& ">"
TraverseComponentFeatures
swApp, swModel, swChildComp, nLevel
TraverseComponent
swApp, swModel, swChildComp, nLevel + 1
Next
i
End Sub
Sub TraverseModelFeatures _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
nLevel
As Long _
)
Dim
swFeat As
SldWorks.feature
Set
swFeat = swModel.FirstFeature
TraverseFeatureFeatures
swApp, swModel, swFeat, nLevel
End Sub
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swConf As
SldWorks.Configuration
Dim
swRootComp As
SldWorks.Component2
Dim
nStart As
Single
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swConf = swModel.GetActiveConfiguration
Set
swRootComp = swConf.GetRootComponent3(true)
nStart
= Timer
Debug.Print
"File = " & swModel.GetPathName
TraverseModelFeatures
swApp, swModel, 1
TraverseComponent
swApp, swModel, swRootComp, 1
Debug.Print
""
Debug.Print
"Time = " & Timer - nStart & " s"
End Sub
'---------------------------------------