Title Block

[martinhoos]

Hello together,

i have a problem with Title Blocks, i like to change the titleblock in all sheets via iLogic. With this code it only changes in the active sheet.

My script is the following (By the way, i do nothing know about iLogic, i just copy together...):

Thank you very much

Regards Martin

ActiveSheet.TitleBlock = "ET-Liste Deutsch"

Dim openDoc As Document
openDoc = ThisDoc.Document
 
'Dim docFile As Document
 
If openDoc.DocumentType = 12292 Then
 
    'Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
    Dim MDocFile As Document
    If ThisDoc.ModelDocument IsNot Nothing Then
         MDocFile = ThisDoc.ModelDocument
         Else
         MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
         Return
    End If
    
    'assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    oDrawDoc = ThisApplication.ActiveDocument
        
    'Set a reference to the active sheet.
    Dim oSheet As Sheet
    oSheet = oDrawDoc.ActiveSheet
    'Look for partlist within drawing. End rule, if it doesn't exist.
    'say there is a Partslist on the sheet.
    Dim oPartslist As PartsList
    oPartslist = oSheet.PartsLists(1)
 
    If oSheet.PartsLists(1) IsNot Nothing Then
 
        'set parts list to a specific style
        oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item("KV-Stueli_Deutsch")
		ThisDrawing.Document.StylesManager.Layers("KV deutsch"​).Visible= True
		ThisDrawing.Document.StylesManager.Layers("KV englisch"​).Visible= False
 
     End If
        
        
    Else
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    
End If

[Owner2229]

Hi, try it now.

ActiveSheet.TitleBlock = "ET-Liste Deutsch"

Dim oDoc As Document = ThisApplication.ActiveDocument
 
If Not oDoc.DocumentType = 12292 Then
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    Exit Sub
End If

' Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
If ThisDoc.ModelDocument Is Nothing Then
    MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
    Exit Sub
End If
    
' Assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument = oDoc
        
' Go throught every sheet.
Dim oSheet As Sheet
For Each oSheet In oDrawDoc.Sheets
    ' Look for partlist within the sheet.
    Dim oPartsList As PartsList = oSheet.PartsLists(1)
    If oPartsList IsNot Nothing Then
        ' Set parts list to a specific style
        oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item("KV-Stueli_Deutsch")
	ThisDrawing.Document.StylesManager.Layers("KV deutsch"​).Visible= True
	ThisDrawing.Document.StylesManager.Layers("KV englisch"​).Visible= False
    End If
Next

[martinhoos]

Thank you Mike,

but, the code did not run, there is a message:

Fehler in Regel: neu in Dokument: Test-ET-Liste_58001926.idw

Falscher Parameter. (Ausnahme von HRESULT: 0x80070057 (E_INVALIDARG))

Maybe it is because i work with Inventor 2015?

Regards from germany

Martin

[Owner2229]

Hi, the problem is probably in the code as it says "wrong parameter". I have probably just made a misstake in it.

Can you please send the screenshots of both pages of the error message please?

[martinhoos]

Here it is... :

[Owner2229]

Alright, the problem is in this line:

oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item("KV-Stueli_Deutsch")

It can't find the item. Can you please use this code and verify if the style is in the output?

Dim oDoc As Document = ThisApplication.ActiveDocument

If Not oDoc.DocumentType = 12292 Then
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    Exit Sub
End If

' Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
If ThisDoc.ModelDocument Is Nothing Then
    MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
    Exit Sub
End If

' Assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument = oDoc

' Go throught every sheet.
Dim oSheet As Sheet
Dim oStyle As Style
Dim oT As String = ""
For Each oStyle In oDrawDoc.StylesManager.PartsListStyles
    oT = oT & vbLf & oStyle.Name
Next
MsgBox(oT)

[martinhoos]

Thanks again...

Here it is.

Regards

Martin

[martinhoos]

Hello Mike,

once again, i checked the code below, it runs (all thinks changed). The only problem is, that the changings are only on the first sheet (page1).

I like to have all sheets changed.

Regards Martin

ActiveSheet.TitleBlock = "ET-Liste Deutsch"

Dim openDoc As Document
openDoc = ThisDoc.Document
 
'Dim docFile As Document
 
If openDoc.DocumentType = 12292 Then
 
    'Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
    Dim MDocFile As Document
    If ThisDoc.ModelDocument IsNot Nothing Then
         MDocFile = ThisDoc.ModelDocument
         Else
         MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
         Return
    End If
    
    'assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    oDrawDoc = ThisApplication.ActiveDocument
        
    'Set a reference to the active sheet.
    Dim oSheet As Sheet
    oSheet = oDrawDoc.ActiveSheet
    'Look for partlist within drawing. End rule, if it doesn't exist.
    'say there is a Partslist on the sheet.
    Dim oPartslist As PartsList
    oPartslist = oSheet.PartsLists(1)
 
    If oSheet.PartsLists(1) IsNot Nothing Then
 
        'set parts list to a specific style
        oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item("KV-Stueli_Deutsch")
		ThisDrawing.Document.StylesManager.Layers("KV deutsch"​).Visible= True
		ThisDrawing.Document.StylesManager.Layers("KV englisch"​).Visible= False
 
     End If
        
        
    Else
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    
End If

[martinhoos]

Hello Mike,

if i copy the code out of my last post and paste it into the drawing, i get the message:

Fehler in Regel: Regel6 in Dokument: Test-ET-Liste_58001926.idw

Falscher Parameter. (Ausnahme von HRESULT: 0x80070057 (E_INVALIDARG))

Maybe there is a probleme with copy and paste? What do i wrong?

Regards Martin

[Owner2229]

Try it now.

ActiveSheet.TitleBlock = "ET-Liste Deutsch"

Dim oDoc As Document = ThisApplication.ActiveDocument

If Not oDoc.DocumentType = 12292 Then
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    Exit Sub
End If

' Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
If ThisDoc.ModelDocument Is Nothing Then
    MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
    Exit Sub
End If

' Assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument = oDoc

' Get the style
Dim oStyle As Style
For Each aStyle As Style In oDrawDoc.StylesManager.PartsListStyles
    If aStyle.Name = "KV-Stueli_Deutsch" Then
        oStyle = aStyle
        Exit For
    End If
Next

' End the Rule if the Style doesn't exist
If oStyle Is Nothing Then Exit Sub

' Go throught every sheet.
Dim oSheet As Sheet
For Each oSheet In oDrawDoc.Sheets
    ' Look for partlist within the sheet.
    If oSheet.PartsLists(1) IsNot Nothing Then
        ' Set parts list to a specific style
        Dim oPartsList As PartsList = oSheet.PartsLists(1)
        oPartsList.Style = oStyle
        oDrawDoc.StylesManager.Layers("KV deutsch"​).Visible= True
        oDrawDoc.StylesManager.Layers("KV englisch"​).Visible= False
    End If
Next

[martinhoos]

Hello Mike,

it looks better...

The first sheet is well done, on the second sheet only the parts list changed. The titleblock and the layer did not.

Regards Martin

[Owner2229]

Ok, this should now work for the Titleblock and the Layers.

Dim oDoc As Document = ThisApplication.ActiveDocument

If Not oDoc.DocumentType = 12292 Then
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    Exit Sub
End If

' Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
If ThisDoc.ModelDocument Is Nothing Then
    MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
    Exit Sub
End If

' Assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument = oDoc

' Get the style
Dim oStyle As Style
For Each aStyle As Style In oDrawDoc.StylesManager.PartsListStyles
    If aStyle.Name = "KV-Stueli_Deutsch" Then
        oStyle = aStyle
        Exit For
    End If
Next

' End the Rule if the Style doesn't exist
If oStyle Is Nothing Then Exit Sub

' Go throught every sheet.
Dim oSheet As Sheet
For Each oSheet In oDrawDoc.Sheets
    oSheet.TitleBlock = "ET-Liste Deutsch"
    ' Look for partlist within the sheet.
    If oSheet.PartsLists(1) IsNot Nothing Then
        ' Set parts list to a specific style
        oSheet.PartsLists(1).Style = oStyle
        ' Change the Layers
        Dim oLayers As LayersEnumerator = oSheet.Parent.StylesManager.Layers
        oLayers.Item("KV deutsch"​).Visible= True
        oLayers.Item("KV englisch"​).Visible= False
    End If
Next

[martinhoos]

Hello Mike,

i get the message:

Regelkompilierungsfehler in Regel6, in Test-ET-Liste_58001926.idw

Fehler in Zeile 32 : Die Eigenschaft "TitleBlock" ist ReadOnly.

Regards Martin

[Owner2229]

Dim oDoc As Document = ThisApplication.ActiveDocument

If Not oDoc.DocumentType = 12292 Then
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    Exit Sub
End If

' Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
If ThisDoc.ModelDocument Is Nothing Then
    MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
    Exit Sub
End If

' Assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument = oDoc

' Get the style
Dim oStyle As Style
For Each aStyle As Style In oDrawDoc.StylesManager.PartsListStyles
    If aStyle.Name = "KV-Stueli_Deutsch" Then
        oStyle = aStyle
        Exit For
    End If
Next

' End the Rule if the Style doesn't exist
If oStyle Is Nothing Then Exit Sub

' Go throught every sheet.
Dim oSheet As Sheet
For Each oSheet In oDrawDoc.Sheets
    oSheet.TitleBlock.Delete
    oSheet.AddTitleBlock = "ET-Liste Deutsch"
    ' Look for partlist within the sheet.
    If oSheet.PartsLists(1) IsNot Nothing Then
        ' Set parts list to a specific style
        oSheet.PartsLists(1).Style = oStyle
        ' Change the Layers
        Dim oLayers As LayersEnumerator = oSheet.Parent.StylesManager.Layers
        oLayers.Item("KV deutsch"​).Visible= True
        oLayers.Item("KV englisch"​).Visible= False
    End If
Next

[martinhoos]

Hello Mike,

this message appears:

Regelkompilierungsfehler in Regel6, in Test-ET-Liste_58001926.idw

Fehler in Zeile 33 : Für den Parameter "TitleBlockDefinition" von "Public Function AddTitleBlock(TitleBlockDefinition As Object, [TitleBlockLocation As Object], [PromptStrings As Object]) As Inventor.TitleBlock" wurde kein Argument angegeben.

Regards Martin

[Owner2229 · Accepted solution]

Dim oDoc As Document = ThisApplication.ActiveDocument

If Not oDoc.DocumentType = 12292 Then
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    Exit Sub
End If

' Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
If ThisDoc.ModelDocument Is Nothing Then
    MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
    Exit Sub
End If

' Get the style
Dim oStyle As Style
For Each aStyle As Style In oDoc.StylesManager.PartsListStyles
    If aStyle.Name = "KV-Stueli_Deutsch" Then
        oStyle = aStyle
        Exit For
    End If
Next

' End the Rule if the Style doesn't exist
If oStyle Is Nothing Then Exit Sub

' Go throught every sheet.
Dim oSheet As Sheet
For Each oSheet In oDoc.Sheets
    oSheet.TitleBlock.Delete
    oSheet.AddTitleBlock("ET-Liste Deutsch")
    ' Look for partlist within the sheet.
    If oSheet.PartsLists(1) IsNot Nothing Then
        ' Set parts list to a specific style
        oSheet.PartsLists(1).Style = oStyle
        ' Change the Layers
        Dim oLayers As LayersEnumerator = oSheet.Parent.StylesManager.Layers
        oLayers.Item("KV deutsch"​).Visible= True
        oLayers.Item("KV englisch"​).Visible= False
    End If
Next

[martinhoos]

Hello Mike,

it works - Thank you very much.... 

Regards Martin

[Owner2229]

You're welcomed. I'm sorry I haven't made it right at once, but I'm a bit distracted today 

[martinhoos]

Hi Mike, its me again... there is one probleme left with the code. If i have a sheet in without partlist, i get the message:

Fehler in Regel: ET_Liste_Deutsch in Dokument: Test-ET-Liste_58001926.idw

Falscher Parameter. (Ausnahme von HRESULT: 0x80070057 (E_INVALIDARG))

Can you help me agai? Thanks a lot!

Regards

Martin

[MechMachineMan]

Dim oDoc As Document = ThisApplication.ActiveDocument

If Not oDoc.DocumentType = 12292 Then
    MessageBox.Show("Es muss eine IDW offen sein um den Code zu verwenden!", "File Type Mismatch!")
    Exit Sub
End If

' Look For the model referenced within the drawing. End the Rule If the drawing Is empty.
If ThisDoc.ModelDocument Is Nothing Then
    MessageBox.Show("Diese Option ist in einer leeren Zeichnung unzulässig", "Export error")
    Exit Sub
End If

' Get the style
Dim oStyle As Style
For Each aStyle As Style In oDoc.StylesManager.PartsListStyles
    If aStyle.Name = "KV-Stueli_Deutsch" Then
        oStyle = aStyle
        Exit For
    End If
Next

' End the Rule if the Style doesn't exist
If oStyle Is Nothing Then Exit Sub

' Go throught every sheet.
Dim oSheet As Sheet
For Each oSheet In oDoc.Sheets
    oSheet.TitleBlock.Delete
    oSheet.AddTitleBlock("ET-Liste Deutsch")
    ' Look for partlist within the sheet.
    If oSheet.PartsLists.Count > 0 Then
        ' Set parts list to a specific style
        oSheet.PartsLists(1).Style = oStyle
        ' Change the Layers
        Dim oLayers As LayersEnumerator = oSheet.Parent.StylesManager.Layers
        oLayers.Item("KV deutsch"​).Visible= True
        oLayers.Item("KV englisch"​).Visible= False
    Else if oSheet.PartsLists.Count > 1
        MsgBox("More than 1 PartsList found on the sheet. Please fix
        Exit Sub
    End If
 Next