Loop through all sheets

[Anonymous]

Hi,

I have adapted code I found for changing the layer of sketch geometry, within a sketch created in a drawing view. But I can't manage to adapt it to loop through all sheets. Below is the code that works for the active sheet only.

How do I get this code to loop through all sheets winthin the .idw?

Thanks for your help

M

' Set a reference to the drawing document.

' This assumes a drawing document is active.

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument

' Set a reference to the active sheet.

Dim oActiveSheet As Sheet

oActiveSheet = oDrawDoc.ActiveSheet

' Create a Drawing View Object

Dim oDrawingView As DrawingView

Dim oDrawingSketch As DrawingSketch

Dim oSketchEntity As SketchEntity

Dim oLayer As Layer

oLayer = oDrawDoc.StylesManager.Layers.Item("test")

For Each oDrawingView In oActiveSheet.DrawingViews

   For Each oDrawingSketch In oDrawingView.Sketches

           If oDrawingSketch.Name = "Workpiece Size" Then

               oDrawingSketch.Edit

               For Each oSketchEntity In oDrawingSketch.SketchEntities

                   oSketchEntity.Layer = oLayer

               Next

               oDrawingSketch.ExitEdit

           End If

   Next

Next

iLogicVb.UpdateWhenDone = True

[MechMachineMan · Accepted solution]

Sub Main()
    oDrawDoc = ThisApplication.ActiveDocument
    oLayer = oDrawDoc.StylesManager.Layers.Item("test")

    For Each oSheet in oDrawDoc.Sheets
        ProcessSheet(oSheet)
    Next

    oDrawDoc.Update
End Sub

Dim oDrawDoc As DrawingDocument
Dim oLayer As Layer

Sub ProcessSheet(oSheet As Sheet)

    Dim oDrawingView As DrawingView
    Dim oDrawingSketch As DrawingSketch
    Dim oSketchEntity As SketchEntity
 
    For Each oDrawingView In oSheet.DrawingViews
       For Each oDrawingSketch In oDrawingView.Sketches
           If oDrawingSketch.Name = "Workpiece Size" Then
               oDrawingSketch.Edit

               For Each oSketchEntity In oDrawingSketch.SketchEntities
                   oSketchEntity.Layer = oLayer
               Next

               oDrawingSketch.ExitEdit
           End If
       Next
    Next
End Sub

[Anonymous]

Hi,

Thanks, this works (sorry for the late reply). This code is perfect. I now need to work out how to replace the line "oLayer = oDrawDoc.StylesManager.Layers.Item("test")" with a layer name that is set per sheet from a promted entry that exists on each sheet. I have adapted code that I have found on cadlinecommunity. This loops through all sheets and creates a layer per sheet based on the promted entry.

Is it possible to replace "oLayer = oDrawDoc.StylesManager.Layers.Item("test")" with the new layer???

Thanks in advance for any help you can give me

M

On Error Resume Next

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument

Dim oSheet As Sheet

Dim oPromptEntry

i = 1

For Each oSheet In oDrawDoc.Sheets

i = i+1

ThisApplication.ActiveDocument.Sheets.Item(i).Activate

       oTitleBlock=oSheet.TitleBlock

   oTextBoxes=oTitleBlock.Definition.Sketch.TextBoxes

   For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes

   Select oTextBox.Text

       Case "{Item.Thickness}"

           oPromptEntry = oTitleBlock.GetResultText(oTextBox)

                       Dim oNEWlayer As Layer

                       oNEWlayer = oDrawDoc.StylesManager.Layers.Item("Workpiece Size").Copy("XLYP1H" & oPromptEntry)

   End Select

   Next

Next

iLogicVb.UpdateWhenDone = True