Macro to hide individually shown planes

Hi All:

I'm working with thousands of legacy parts and assys where all the reference planes have been saved and vaulted with the planes "shown".

We are trying to finally build some top-level assemblies, and I've been working at defining critical datums so that we can begin to use SWX properly to design our machines.

My efforts are damped though by the fact that every part has the planes shown. So if I turn on planes in an assembly there are so many you can't see anything. Yes, I know how to pick them from the tree for mating and all but visualizing the datums is very helpful providing you can see what you need to see.

So what I'm looking for is a macro that can run from an upper level of the assembly and hide the planes.

Anyone?

It only takes a minor mod to a API help file example

'------------------------------------------------------------------

' 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 BlankRefFeature _ ( _ swApp As SldWorks.SldWorks, _ swModel As SldWorks.ModelDoc2, _ swFeat As SldWorks.Feature _ )

Dim bRet As Boolean Dim pln As SldWorks.RefPlane

If "RefPlane" = swFeat.GetTypeName Then

bRet = swFeat.Select2(False, 0): Debug.Assert bRet swModel.BlankRefGeom

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 BlankRefFeature swApp, swModel, swFeat

Set swSubFeat = swFeat.GetFirstSubFeature

While Not swSubFeat Is Nothing

Debug.Print sPadStr + " " + swSubFeat.Name + " [" + swSubFeat.GetTypeName + "]"

BlankSketchFeature swApp, swModel, swSubFeat BlankRefFeature swApp, swModel, swFeat

Set swSubSubFeat = swSubFeat.GetFirstSubFeature

While Not swSubSubFeat Is Nothing

Debug.Print sPadStr + " " + swSubSubFeat.Name + " ["

swSubSubFeat.GetTypeName + "]"

BlankSketchFeature swApp, swModel, swSubSubFeat BlankRefFeature swApp, swModel, swFeat

Set swSubSubSubFeat = swSubFeat.GetFirstSubFeature

While Not swSubSubSubFeat Is Nothing

Debug.Print sPadStr + " " + swSubSubSubFeat.Name + " [" + swSubSubSubFeat.GetTypeName + "]"

BlankSketchFeature swApp, swModel, swSubSubSubFeat BlankRefFeature swApp, swModel, swFeat

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 & " "

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.GetRootComponent

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

'---------------------------------------

TODD wrote: