partlist style

[martinhoos]

Hello all,

the following script changes from german to englisch or from englisch to german. i copied the script from several Posts  😉

It runs ok but at this time i have a problem with two "new" partlist-styles:

blech-german

blech_englisch

Long Story short: If i use a sheetmetal idw i have to use "blech-german" or "blech-englisch" otherwise "kv-stueli_deutsch" or "kv-stueli_englisch"

How can i check if sheetmetal is used?

Hopefully you can help me.

Regards

Martin

'List of Variables    
	Dim oDrawingDoc As Inventor.DrawingDocument
    Dim oSheetNumber As Integer
	Dim oActiveSheetNumber As Integer
	Dim oActiveSheetName As String	
	Dim oSheet As Sheet
    Dim oSourceTitleBlockDef As TitleBlockDefinition
    Dim oNewTitleBlockDef As TitleBlockDefinition

'Selects this document
	oDrawingDoc = ThisApplication.ActiveDocument
    oSheet = oDrawingDoc.ActiveSheet

	Dim oTitle As TitleBlockDefinition
	Dim oTitleBlock As TitleBlock

'Adds the Title Blocks from the Template File
ThisDrawing.ResourceFileName = "v:\Inventor-2015\1-Inventor\TEMPLATES\abc.idw"
ThisDrawing.KeepExtraResources = True

ActiveSheet.TitleBlock = "abc_Englisch"
ActiveSheet.TitleBlock = "abc"

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_Englisch" Then
        oStyle = aStyle
        Exit For
    End If
Next

Dim styleMgr As DrawingStylesManager = oDoc.StylesManager

Dim deutschLayer As Layer
Try
    ' Attempt to get the layer named "KV deutsch".
    deutschLayer = styleMgr.Layers.Item("KV deutsch")
Catch ex As Exception
    ' The layer doesn't exist, so create it.
    deutschLayer = styleMgr.Layers.Item(1).Copy("KV deutsch")
    deutschLayer.Color = ThisApplication.TransientObjects.CreateColor(0, 0, 0)
    deutschLayer.LineWeight = 0.35
    deutschLayer.LineType = LineTypeEnum.kContinuousLineType
End Try

Dim englischLayer As Layer
Try
    ' Attempt to get the layer named "KV englisch".
    englischLayer = styleMgr.Layers.Item("KV englisch")
Catch ex As Exception
    ' The layer doesn't exist, so create it.
    englischLayer = styleMgr.Layers.Item(1).Copy("KV englisch")
    englischLayer.Color = ThisApplication.TransientObjects.CreateColor(0, 0, 0)
    englischLayer.LineWeight = 0.35
    englischLayer.LineType = LineTypeEnum.kContinuousLineType
End Try

' 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.Activate
    oSheet.TitleBlock.Delete
    oSheet.AddTitleBlock("abc_Englisch")
    ' Look for partlist within the sheet.
        ' Change the Layers
        Dim oLayers As LayersEnumerator = oSheet.Parent.StylesManager.Layers
        oLayers.Item("KV deutsch"​).Visible= False
        oLayers.Item("KV englisch"​).Visible= True
		
If oSheet.PartsLists.Count = 0 Then Continue For
    If oSheet.PartsLists(1) IsNot Nothing Then
        ' Set parts list to a specific style
        oSheet.PartsLists(1).Style = oStyle
oSheet.Update
    End If
Next
ActiveSheet = ThisDrawing.Sheet("Blatt:1")

[chandra.shekar.g · Accepted solution]

Hi @martinhoos,

Try the following VBA code to check sheet metal in DrawingDocument.

Sub Main()
    
    Dim oDrawingDoc As DrawingDocument
    Set oDrawingDoc = ThisApplication.ActiveDocument
    
    Dim oReferDoc As Document
    For Each oReferDoc In oDrawingDoc.ReferencedDocuments
        If oReferDoc.DocumentSubType.DocumentSubTypeID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
            MsgBox ("Referenced document is sheet metal document")
        End If
    Next

End Sub

Please feel free to contact if there is any doubt.

If solves problem, click on "Accept as solution" / give a "Kudo".

Thanks and regards,

[martinhoos]

Hi Chandra,

thx very much, thats it.

Regards Martin