Help Running Part Level code from an Assembly - Should be easy but i cant see it

[roy_pridham]

Hello All,

I have basically automated our drawings but in the 3. DXF Creater its just not getting the correct Properties.

hopefully someone can help and others can probably use it.

This is my Top Level Code which cycles through the parts.

Sub Main()
    RunDrawingAutomation()
End Sub

Sub RunDrawingAutomation()
    ' Ensure the active document is an assembly document
    If ThisApplication.ActiveDocument.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
        MessageBox.Show("The active document is not an assembly.")
        Return
    End If

    Dim assemblyDoc As AssemblyDocument
    assemblyDoc = ThisApplication.ActiveDocument
    
    Dim assemblyDef As AssemblyComponentDefinition
    assemblyDef = assemblyDoc.ComponentDefinition

    ' Access the BOM
    Dim bom As BOM
    bom = assemblyDef.BOM

    ' Ensure the BOM is enabled
    If Not bom.PartsOnlyViewEnabled Then
        bom.PartsOnlyViewEnabled = True
    End If
    
    ' Iterate through the BOM "Parts Only" view
    Dim bomView As BOMView
    bomView = bom.BOMViews.Item("Parts Only")

    ' Iterate through the BOM rows
    Dim bomRow As BOMRow
    For Each bomRow In bomView.BOMRows
        Dim partDoc As Document
        partDoc = bomRow.ComponentDefinitions.Item(1).Document
        
        Dim customPropSet As PropertySet
        Dim serialNumber As String = ""
        Dim propExists As Boolean = False
        
        Try
            customPropSet = partDoc.PropertySets.Item("Inventor User Defined Properties")
            serialNumber = customPropSet.Item("Serial Number").Value
            If TypeOf serialNumber Is String Then
                serialNumber = CStr(serialNumber)
                propExists = True
            End If
        Catch ex As Exception
            ' If the property set or property does not exist, skip this part
            propExists = False
        End Try

        ' Check if the Serial Number contains "PL" followed by 3 digits
        If propExists AndAlso serialNumber Like "*PL###*" Then
            ' Get the full file path of the part document
            Dim partPath As String
            partPath = partDoc.FullFileName
            
            ' Open the part document with write permissions (True = not read-only)
            Try
                Dim openedPartDoc As Document
                openedPartDoc = ThisApplication.Documents.Open(partPath, True)
                'MessageBox.Show("Opened part document: " & openedPartDoc.FullFileName)

                ' Run the external iLogic rule on the opened part document
                Try
                    ' Ensure the opened document is the active document
                    'ThisApplication.ActiveDocument = openedPartDoc
                    iLogicVb.RunExternalRule("2. Drawing Automation Tool")
                Catch ex As Exception
                    MessageBox.Show("Failed to run the iLogic rule on part document: " & partPath & vbCrLf & "Error: " & ex.Message)
                End Try

                ' Save and close the part document
                Try
                    openedPartDoc.Save()
                    openedPartDoc.Close(True)
                Catch ex As Exception
                    ' Handle any errors that occur while closing the part document
                    MessageBox.Show("Failed to save and close part document: " & partPath & vbCrLf & "Error: " & ex.Message)
                End Try

                ' Prompt to continue or cancel
                Dim result As MsgBoxResult
                result = MsgBox("Do you want to continue running the iLogic rule for the next part?", vbYesNo + vbQuestion, "Continue?")
                
                If result = vbNo Then
                    Exit Sub
                End If
            Catch ex As Exception
                ' Handle any errors that occur while opening the part document
                MessageBox.Show("Failed to open part document: " & partPath & vbCrLf & "Error: " & ex.Message)
            End Try
        End If
    Next
End Sub

This code basically runs all the other tools these all work except the DXF rule:

Sub Main()
    ' Automatically check out the document if it's not already checked out
    CheckOutDocument()

    ' Ensure the active document is a part document
    If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
        Dim partDoc As Document
        partDoc = ThisApplication.ActiveDocument
        
        ' Run Script 3: Create the DXF
        iLogicVb.RunExternalRule("3. DXF Creater DA")

        ' Run Script 4: Create the drawing
        iLogicVb.RunExternalRule("4. Drawing Creator DA")
        
        ' Run Script 4.1: Centre Dims   
        iLogicVb.RunExternalRule("Dim Centre")
        
        ' Run Script 5: Save the drawing
        iLogicVb.RunExternalRule("5. Save As Serial No")

        ' Ask if edits are needed and log the path if necessary
        Dim result As DialogResult = MessageBox.Show("Do you need to edit the drawing before proceeding?", "Edit Check", MessageBoxButtons.YesNo)
        If result = DialogResult.Yes Then
            LogDrawingPathForEdits()
        End If
        
        ' Run Script 6: Create the PDF with enhanced error handling
        Try
            ExportPDF()
        Catch ex As Exception
            MessageBox.Show("Failed to create PDF. Error: " & ex.Message, "Error")
        End Try

        ' Check the drawing and part back into Vault and close them
        CheckInAndClose()
    Else
        MessageBox.Show("The active document is not a part document.")
        Return
    End If
End Sub

Sub CheckOutDocument()
    Try
        Dim oControlDef As Inventor.ControlDefinition = ThisApplication.CommandManager.ControlDefinitions.Item("VaultCheckoutTop")
        oControlDef.Execute2(True) ' Synchronous execution; wait for the commands ending before rule exits
    Catch ex As Exception
        MessageBox.Show("Failed to check out the document. Error: " & ex.Message, "Error")
    End Try
End Sub

Sub LogDrawingPathForEdits()
    Try
        ' Get the path of the active drawing
        Dim drawingPath As String = ThisApplication.ActiveDocument.FullFileName

        ' Define the path for the log file
        Dim logFolderPath As String = "C:\temp\" & Format(Now, "yyyy-MM-dd") & "-drawings to fix"
        Dim logFilePath As String = logFolderPath & "\drawings_to_fix.txt"

        ' Create the directory if it doesn't exist
        If Not System.IO.Directory.Exists(logFolderPath) Then
            System.IO.Directory.CreateDirectory(logFolderPath)
        End If

        ' Check if the drawing path is already in the file
        If System.IO.File.Exists(logFilePath) Then
            Dim existingPaths As String() = System.IO.File.ReadAllLines(logFilePath)
            If existingPaths.Contains(drawingPath) Then
                Return
            End If
        End If

        ' Append the drawing path to the file
        Using writer As New System.IO.StreamWriter(logFilePath, True)
            writer.WriteLine(drawingPath)
        End Using
    Catch ex As Exception
        MessageBox.Show("Failed to log drawing path for edits. Error: " & ex.Message, "Error")
    End Try
End Sub

Sub ExportPDF()
    ' Ensure the active document is a drawing document
    If ThisApplication.ActiveDocument.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
        MessageBox.Show("The active document is not a drawing.")
        Return
    End If

    ' Define the path for the PDF
    Dim drawingDoc As DrawingDocument = ThisApplication.ActiveDocument
    Dim pdfFileName As String = System.IO.Path.ChangeExtension(drawingDoc.FullFileName, "pdf")

    Try
        ' Prepare the PDF export options
        Dim oPDFAddIn As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
        Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext()
        oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism

        Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap()
        If oPDFAddIn.HasSaveCopyAsOptions(drawingDoc, oContext, oOptions) Then
            oOptions.Value("All_Color_AS_Black") = 0
            oOptions.Value("Remove_Line_Weights") = 0
            oOptions.Value("Vector_Resolution") = 400
            oOptions.Value("Sheet_Range") = PrintRangeEnum.kPrintAllSheets
        End If

        Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium()
        oDataMedium.FileName = pdfFileName

        ' Export the document as PDF
        oPDFAddIn.SaveCopyAs(drawingDoc, oContext, oOptions, oDataMedium)
        MessageBox.Show("PDF export successful.")
    Catch ex As Exception
        MessageBox.Show("Failed to export PDF. Error: " & ex.Message)
    End Try
End Sub

Sub CheckInAndClose()
    Try
        ' Check in the active document (drawing)
        Dim drawingDoc As Document = ThisApplication.ActiveDocument
        If drawingDoc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
            Dim oControlDef As Inventor.ControlDefinition = ThisApplication.CommandManager.ControlDefinitions.Item("VaultCheckinTop")
            oControlDef.Execute2(True) ' Synchronous execution; wait for the commands ending before rule exits
        End If

        ' Close the documents
        drawingDoc.Close(True)
        Dim partDoc As Document = Nothing
        If ThisApplication.Documents.OfType(Of PartDocument).Count > 0 Then
            partDoc = ThisApplication.Documents.OfType(Of PartDocument).First()
            partDoc.Close(True)
        End If
    Catch ex As Exception
        MessageBox.Show("Failed to check in and close documents. Error: " & ex.Message, "Error")
    End Try
End Sub

this is the weird one, line 8 which is

 Dim SetTheFilenameHere As String = GetProperty(partDoc, "Inventor User Defined Properties", "Serial Number") & " - " & GetProperty(partDoc, "Design Tracking Properties", "Stock Number") & " - x" & GetProperty(partDoc, "Inventor User Defined Properties", "TotalQty") 

This will get properties from random parts not the open one.

the whole block 

Sub Main()
    ' Check if there is an active document and if it is a part document
    If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
        Dim partDoc As PartDocument = ThisApplication.ActiveDocument

        ' Set file path and filename based on iProperties from the active part document
        Dim SetTheFilePathHere As String = System.IO.Path.GetDirectoryName(partDoc.FullFileName)
        Dim SetTheFilenameHere As String = GetProperty(partDoc, "Inventor User Defined Properties", "Serial Number") & " - " & GetProperty(partDoc, "Design Tracking Properties", "Stock Number") & " - x" & GetProperty(partDoc, "Inventor User Defined Properties", "TotalQty")

        ' Continue with the rest of the code using the active part document
        ProcessPartDocument(partDoc, SetTheFilePathHere, SetTheFilenameHere)
    Else
        MessageBox.Show("The active document is not a part document.")
        Return
    End If
End Sub

Function GetProperty(doc As Document, propertySetName As String, propertyName As String) As String
    Try
        Dim propSet As PropertySet = doc.PropertySets.Item(propertySetName)
        Dim prop As [Property] = propSet.Item(propertyName)
        If prop IsNot Nothing Then
            Return prop.Value
        Else
            Return ""
        End If
    Catch ex As Exception
        MessageBox.Show("Failed to get property '" & propertyName & "' from property set '" & propertySetName & "'. Error: " & ex.Message, "Error")
        Return ""
    End Try
End Function

Sub ProcessPartDocument(doc As PartDocument, SetTheFilePathHere As String, SetTheFilenameHere As String)
    Try
        ThisApplication.StatusBarText = "Finding the Biggest Face to Export as DXF"

        ' Reference the part component definition
        Dim compDef As PartComponentDefinition = doc.ComponentDefinition
        Dim biggestFace As Face = Nothing
        Dim maxArea As Double = 0

        ' Iterate through all faces to find the biggest one
        For Each face As Face In compDef.SurfaceBodies(1).Faces
            Dim area As Double = Face.Evaluator.Area
            If area > maxArea Then
                maxArea = area
                biggestFace = Face
            End If
        Next

        ' Check if the biggest face was found
        If biggestFace Is Nothing Then
            MessageBox.Show("No faces found in the document.", "Error")
            Exit Sub
        End If

        ' Get the file path and check if it contains "Jobs"
        Dim filePathArray() As String
        filePathArray = Split(SetTheFilePathHere, "\")
        Dim newPath As String = ""

        If UBound(filePathArray) >= 4 And InStr(SetTheFilePathHere, "Jobs") > 0 Then
            ' Create the new folder at the 5th level if it doesn't exist
            Dim i As Integer
            For i = 0 To 4
                newPath = newPath & filePathArray(i) & "\"
            Next
            newPath = newPath & "Drawing Files"
            If Dir(newPath, vbDirectory) = "" Then
                MkDir(newPath)
            End If
            ' Set the new file path
            SetTheFilePathHere = newPath
        End If

        ' Select the biggest face and export as DXF
        doc.SelectSet.Select(biggestFace)
        ThisApplication.CommandManager.PostPrivateEvent(kFileNameEvent, SetTheFilePathHere & "\" & SetTheFilenameHere & ".dxf")

        ' Update status bar and execute DXF export
        ThisApplication.StatusBarText = "Exporting your DXF, Have a Beer"
        
        Try
            Dim oCtrlDef As ButtonDefinition
            oCtrlDef = ThisApplication.CommandManager.ControlDefinitions.Item("GeomToDXFCommand")
            oCtrlDef.Execute()
            ThisApplication.StatusBarText = "Success! - DXF exported : Good Job You're Amazing"
        Catch ex As Exception
            MessageBox.Show("Failed to execute DXF export command: " & ex.Message, "Error")
            ThisApplication.StatusBarText = "DXF export failed. Please try again."
        End Try
        
        InventorVb.DocumentUpdate(False)
    Catch ex As Exception
        MessageBox.Show("An error occurred in ProcessPartDocument: " & ex.Message, "Error")
    End Try
End Sub

[AndrewHumiston]

Good morning,

Just a guess, but you might want to check what part its pulling that code from. set up a

 msgbox("Part Checker: " & PartDoc.name), vbokonly, "Tester...")

that way you can see what part its looking at my first suspicion is that its not looking at the correct part file because you are using a variable that might be inadvertently assigned to the wrong part. this is tricky when using multiple rules to fire commands.