1. Home
  2. Solidworks CAD Design software
  3. macro to clean up files

macro to clean up files

Hello Everyone,

I have a dilema. I cant seem to get one method to work. It is the .BlankRefGeom method. Here is the code:

Dim swApp As Object Dim Part As Object Dim subFeat As Object Dim featureName, subFeatureName As String Dim FeatureIncrement As Integer Dim selmgr As SelectionMgr Dim Feature As Object Dim PlaneRef As ModelDoc2 Dim Plane As Component2

Sub main() Set swApp = CreateObject("SldWorks.Application") Set Part = swApp.ActiveDoc Set Feature = Part.FirstFeature

While Not Feature Is Nothing If Feature.GetTypeName = "RefPlane" Then Plane = Feature.GetSelectedObjectsComponent() PlaneRef = Plane.GetModelDoc PlaneRef.BlankRefGeom End If Set Feature = Feature.GetNextFeature() Wend Part.ForceRebuild3 (True)

Set swApp = Application.SldWorks End Sub

I have tried using many different kinds of objects with the command but it doesnt seem to be recognized. The code is designed to go through the model tree manager and select each reference plane it comes across and hides it. The idea being I could integrate it into a save command so when I open assemblies the

3000+ reference planes from the various parts wont be visible.

Thanks for your help.

Reply to
Electric Gecko
Loading thread data ...

Here are the macros I use. From the SolidWorks API Help section (one to hide Planes the other to hide sketches for assemblies):

Code 'Traverse Assembly and Hide All Planes Example (VB) 'This example shows how to traverse an assembly and hide all Planes.

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

'

' Preconditions: An assembly is open.

'

' Postconditions: All Planes in the assembly are hidden.

'

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

Option Explicit

Sub BlankRefGeomFeature(swApp As SldWorks.SldWorks, _ swModel As SldWorks.ModelDoc2, _ swFeat As SldWorks.Feature)

Dim bRet As Boolean

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 + "]"

BlankRefGeomFeature swApp, swModel, swFeat

Set swSubFeat = swFeat.GetFirstSubFeature

While Not swSubFeat Is Nothing

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

BlankRefGeomFeature swApp, swModel, swSubFeat

Set swSubSubFeat = swSubFeat.GetFirstSubFeature

While Not swSubSubFeat Is Nothing

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

  • swSubSubFeat.GetTypeName + "]"

BlankRefGeomFeature swApp, swModel, swSubSubFeat

Set swSubSubSubFeat = swSubFeat.GetFirstSubFeature

While Not swSubSubSubFeat Is Nothing

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

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

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

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

'End of Code for Hiding Planes

'Traverse Assembly and Hide All Sketches Example (VB) '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 & " "

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

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

Reply to
raulsimental

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.