<?xml encoding=”UTF-8″>By Adam Nagy
This is a continuation of the article UnInclude WorkSurfaces in a DrawingView
The only difference is that now we are iterating through all the sheets and all the drawing views on them, and also take into account the fact that the referenced document could be an assembly or a part.
VBA code:
Sub CollectSurfacesInPart( _
doc As PartDocument, occ As ComponentOccurrence, _
coll As ObjectCollection)
Dim ws As WorkSurface
Dim pcd As PartComponentDefinition
Set pcd = doc.ComponentDefinition
For Each ws In pcd.WorkSurfaces
Dim wsp As WorkSurfaceProxy
If Not occ Is Nothing Then
Call occ.CreateGeometryProxy(ws, wsp)
Call coll.Add(wsp)
Else
Call coll.Add(ws)
End If
Next
End Sub
Sub CollectSurfacesInAssembly( _
occs As ComponentOccurrences, coll As ObjectCollection)
Dim occ As ComponentOccurrence
For Each occ In occs
If occ.SubOccurrences.Count > 0 Then
Call CollectSurfacesInAssembly(occ.SubOccurrences, coll)
End If
If TypeOf occ.Definition Is PartComponentDefinition Then
Call CollectSurfacesInPart(occ.Definition.Document, occ, coll)
End If
Next
End Sub
Sub IncludeAllSurfacesNot()
Dim dwg As DrawingDocument
Set dwg = ThisApplication.ActiveDocument
' Iterate through all the sheets
Dim sh As Sheet
For Each sh In dwg.Sheets
' Iterate through all the views
Dim dv As DrawingView
For Each dv In sh.DrawingViews
Dim doc As Document
Set doc = dv.ReferencedDocumentDescriptor.ReferencedDocument
Dim tro As TransientObjects
Set tro = ThisApplication.TransientObjects
Dim coll As ObjectCollection
Set coll = tro.CreateObjectCollection
If TypeOf doc Is AssemblyDocument Then
Call CollectSurfacesInAssembly( _
doc.ComponentDefinition.Occurrences, coll)
ElseIf TypeOf doc Is PartDocument Then
Call CollectSurfacesInPart(doc, Nothing, coll)
End If
Dim ws As WorkSurface
For Each ws In coll
Call dv.SetIncludeStatus(ws, False)
Next
Next
Next
End Sub
iLogic Rule:
Sub Main()
Dim dwg As DrawingDocument
dwg = ThisApplication.ActiveDocument
' Iterate through all the sheets
Dim sh As Sheet
For Each sh In dwg.Sheets
' Iterate through all the views
Dim dv As DrawingView
For Each dv In sh.DrawingViews
Dim doc As Document
doc = dv.ReferencedDocumentDescriptor.ReferencedDocument
Dim tro As TransientObjects
tro = ThisApplication.TransientObjects
Dim coll As ObjectCollection
coll = tro.CreateObjectCollection
If TypeOf doc Is AssemblyDocument Then
Call CollectSurfacesInAssembly( _
doc.ComponentDefinition.Occurrences, coll)
ElseIf TypeOf doc Is PartDocument Then
Call CollectSurfacesInPart(doc, Nothing, coll)
End If
Dim ws As WorkSurface
For Each ws In coll
Call dv.SetIncludeStatus(ws, False)
Next
Next
Next
End Sub
Sub CollectSurfacesInPart( _
doc As PartDocument, occ As ComponentOccurrence, _
coll As ObjectCollection)
Dim ws As WorkSurface
Dim pcd As PartComponentDefinition
pcd = doc.ComponentDefinition
For Each ws In pcd.WorkSurfaces
Dim wsp As WorkSurfaceProxy
If Not occ Is Nothing Then
Call occ.CreateGeometryProxy(ws, wsp)
Call coll.Add(wsp)
Else
Call coll.Add(ws)
End If
Next
End Sub
Sub CollectSurfacesInAssembly( _
occs As ComponentOccurrences, coll As ObjectCollection)
Dim occ As ComponentOccurrence
For Each occ In occs
If occ.SubOccurrences.Count > 0 Then
Call CollectSurfacesInAssembly(occ.SubOccurrences, coll)
End If
If TypeOf occ.Definition Is PartComponentDefinition Then
Call CollectSurfacesInPart(occ.Definition.Document, occ, coll)
End If
Next
End Sub
Here you can see a sample model where the above code would switch off all the work surfaces on all the sheets, whether the view has a part or assembly in it:


Leave a Reply to MikeCancel reply