Hi, oh that's weird. Well, here it is in text:
Imports System.IO.Path
Imports System.IO
Imports System.Collections
Sub Main()
oDoc = ThisApplication.ActiveDocument
If oDoc.SubType <> "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}" Then
MessageBox.Show("Please run this rule in a Worklist","Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
ProjectNumber = "12345" 'oSymbol.GetResultText(oTextBox)
WorklistNumber = "w01" 'oSymbol.GetResultText(oTextBox)
'
'active drawing document
Dim oDrawDoc As DrawingDocument = oDoc
'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
'Check if there are more then one views used and if they have the same reference
For Each oSheet As Sheet In oDrawDoc.Sheets
For Each oView As DrawingView In oSheet.DrawingViews
oAsmDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument
Next
Next
'Define assembly component deffinition
Dim oAsmCompDef As AssemblyComponentDefinition
oAsmCompDef = oAsmDoc.ComponentDefinition
'look at the files referenced by the Assembly
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
'Define and Start Progress Bar
Dim PrgFull As Integer = 0
For Each oRefDoc In oRefDocs
PrgFull = PrgFull + 1
Next
'set assembly name
Dim oAsmName As String
If Right(oAsmDoc.DisplayName, 4) = ".ipt" Or Right(oAsmDoc.DisplayName, 4) = ".iam" Or Right(oAsmDoc.DisplayName, 4) = ".idw" Or Right(oAsmDoc.DisplayName, 4) = ".ipn" Then
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) - 4)
Else
oAsmName = oAsmDoc.DisplayName
End If
'Get part description and filter text
Dim DescriptAssy As String
Try
DescriptAssy = CleanString(oAsmDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value)
Catch
DescriptAssy = "0"
End Try
'Occurance counter
Dim OccCounter As Integer
Dim sFileName As String
sFileName = ProjectNumber & WorklistNumber
'Set the XML file location
Dim listname As String
listname = "C:\Users\hilder\Desktop\" & sFileName & ".xml"
'Create batch file
oWrite = System.IO.File.CreateText(listname)
'Dim array needed for piping pieces
Dim FileList As New List(Of String)
Dim MissingFiles As New List(Of String)
Dim i As Integer = 1
'Start For Loop
For Each oRefDoc In oRefDocs
' 'Sheet metal 'part 'assembly 'design element 'weldment
If oRefDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Or oRefDoc.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Or oRefDoc.SubType = "{E60F81E1-49B3-11D0-93C3-7E0706000000}" Or oRefDoc.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then
Dim oPartDoc As Document
oPartDoc = oRefDoc
'Check if part is purchased part
Dim CustomPropertySet As PropertySet
CustomPropertySet = oPartDoc.PropertySets.Item("Inventor User Defined Properties")
Dim ActieProperty As String
ActieProperty = CustomPropertySet.Item("Actie").Value
If ActieProperty = "INK" Then
Else
'determine operation and step
Dim PartOperation As String
Dim BewPropterty As String
BewPropterty = CustomPropertySet.Item("Bewerking").Value
If BewProperty = "A" Then
PartOperation = "Snijden"
Else If BewProperty = "B" Then
PartOperation = "Kanten"
Else If BewProperty= "C" Then
PartOperation = "Lassen"
Else If BewProperty = "D" Then
PartOperation = "Spuiten"
Else If BewProperty = "E" Then
PartOperation = "Samenbouwen"
Else If BewProperty = "F" Then
PartOperation = "Verpakken"
Else PartOperation = "Onbekend"
End If
'Display name .ipt check
Dim ExportName As String
If Right(oRefDoc.DisplayName, 4) = ".ipt" Or Right(oRefDoc.DisplayName, 4) = ".iam" Then
ExportName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) - 4)
Else
ExportName = oRefDoc.DisplayName
End If
'Project number in name check
Dim ExportSubFolder As String
'Setting counter to 0 and the counting occurances
OccCounter = 0
For Each oOccurrence As ComponentOccurrence In oAsmCompDef.Occurrences.AllReferencedOccurrences(oAsmCompDef)
If oOccurrence.Name.StartsWith(ExportName) Then
'Check for mirrors
If InStr(oOccurrence.Name, "_MIR") > 0 And Not InStr(ExportName, "_MIR") <> 0 Then
Else If InStr(oOccurrence.Name, "_Mir") > 0 And Not InStr(ExportName, "_Mir") <> 0 Then
Else
OccCounter = OccCounter + 1
End If
End If
Next
'If there are no occurencens of the refferenced part, the refference is derived and does not need to be exported
If Not OccCounter = 0 Then
'Get Part number
Dim Part_Number As String
Part_Number = oRefDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
'Extract Porject or worklistnumber from file name to use as classification
Dim IconNumber As String
If InStr(Part_Number, ".") > 2 Then
IconNumber = Left(Part_Number, 5)
Else If InStr(Part_Number, ".") = 0 Then
IconNumber = "Manual"
Else
IconNumber = Mid(Part_Number, 3, 2)
End If
'Get part description and filter text
Dim Descript As String
Try
Descript = CleanString(oRefDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value)
Catch
Descript = "0"
End Try
oWrite.WriteLine(Chr(34) & Part_Number & Chr(34))
oWrite.WriteLine("<Operation>" & PartOperation & "</Operation>")
oWrite.WriteLine("<Step>" & BewPropterty & "</Step>")
'
i = i + 1
End If
End If
'Else 'else for purchase addition
End If
' End If
Next
'Close Document
oWrite.Close()
End Sub
Sub NameReset(oOccs As ComponentOccurrences)
For Each oOcc As ComponentOccurrence In oOccs
Try
oOcc.Name = ""
NameReset(oOcc.SubOccurrences)
Catch
End Try
Next
End Sub
Function CleanString(PrtDesc As String) As String
Dim output As String
Dim c As Object 'since char & variant type does not exist in vba, we have to use object type.
For j = 1 To Len(PrtDesc)
c = Mid(PrtDesc, j, 1) 'Select the character at the j position
If (c >= "a" And c <= "z") Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Then
output = output & c 'add the character to your output.
Else
output = output & " " 'add the replacement character (space) to your output
End If
Next
CleanString = output
End Function
