Runtime error 76, path not found

Runtime error 76, path not found

EMVC
Advocate Advocate
1,577 Views
2 Replies
Message 1 of 3

Runtime error 76, path not found

EMVC
Advocate
Advocate

Hello

 

Me and my friend try to use this VBA on my inventor 2019 it works perfect, my frien have inventor 2016 and got this trouble, what can be wrong

 

Sub Export_Plasma()

    'define the active document as an assembly file
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument
    
    Dim oAsmName As String
    oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) - 4)
           
    'check that the active document is an assembly file
    If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
        
        MsgBox ("Please run this rule from the assembly file.")
        Exit Sub
        
    End If
    
    'get user input
    result = MsgBox("This will create plasma DWG file for all of the asembly components that are sheet metal." _
    & vbLf & "This rule expects that the part file is saved." _
    & vbLf & " " _
    & vbLf & "Are you sure you want to create plasma DWG for all of the assembly components?" _
    & vbLf & "This could take a minute.", vbYesNo, "This create DWG plasma files ")
    
    If result = vbNo Then
    
        Exit Sub
        
    End If
    
    Dim oPath As String
    Dim iSplit As Integer
    
    iSplit = InStrRev(oAsmDoc.FullDocumentName, "\")
    
    oPath = Left(oAsmDoc.FullDocumentName, iSplit - 1)
     
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
    
    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    
    oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
    
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    
    'get DWG target folder path
    Dim oFolder As String
    oFolder = oPath & "\" & oAsmName & " Plasma Filer"
    
    'Check for the DWG folder and create it if it does not exist
    If Len(Dir(oFolder, vbDirectory)) = 0 Then
        MkDir oFolder
    End If
    '- - - - - - - - - - - - -
    
    '- - - - - - - - - - - - -Component  - - - - - - - - - - - -
    'look at the files referenced by the assembly
    Dim oRefDocs As DocumentsEnumerator
    
    Set oRefDocs = oAsmDoc.AllReferencedDocuments
    
    Dim oRefDoc As Document
    Dim iptPathName As String
    
    'work the the drawing files for the referenced models
    'this expects that the model has been saved
    For Each oRefDoc In oRefDocs
    
        If oRefDoc.DocumentSubType.DocumentSubTypeID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
    
            Dim oDrawDoc As PartDocument
            
            Set oDrawDoc = ThisApplication.Documents.Open(oRefDoc.FullDocumentName, True)
            
           Dim oDef As SheetMetalComponentDefinition
           Set oDef = oDrawDoc.ComponentDefinition

           Dim oThick As String
        oThick = oDef.ActiveSheetMetalStyle.Thickness

        Dim oMaterial As String
        oMaterial = oDrawDoc.ActiveMaterial.DisplayName

         oFolder = oPath & "\" & oAsmName & " Plasma Filer\" & oThick & "-" & oMaterial

        'Check for the DWG folder and create it if it does not exist
         If Len(Dir(oFolder, vbDirectory)) = 0 Then
         MkDir oFolder
          End If
            
            oFilename = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) - 4)
            
            'Set the DWG target file name
            oDataMedium.filename = oFolder & "\" & oFilename & ".dwg"
        
            Dim oCompDef As SheetMetalComponentDefinition
        
            Set oCompDef = oDrawDoc.ComponentDefinition
            
            If oCompDef.HasFlatPattern = False Then
            
                oCompDef.Unfold
                
            Else
            
             oCompDef.FlatPattern.Edit
             
                                                    
             End If
           
             
        Dim sOut As String
        
       'config
    'Change values located here to change output.
    sOut = "FLAT PATTERN DWG?AcadVersion=2004" _
    + "&OuterProfileLayer=Cut&OuterProfileLayerColor= 0;255;0" _
    + "&InteriorProfilesLayer=Cut&InteriorProfilesLayerColor= 0;255;0" _
    + "&FeatureProfilesLayer=Scribe&FeatureProfilesLayerColor= 255;0;255" _
    + "&FeatureProfilesDownLayer=Scribe&FeatureProfilesDownLayerColor= 255;0;255" _
    + "&InvisibleLayers=IV_BEND;IV_BEND_DOWN;IV_TANGENT;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_UNCONSUMED_SKETCHES;IV_ROLL_TANGENT;IV_ROLL" _
           
'/config
    
            Dim Message, Title, Default, MyValue
            Message = "Enter a value between 1 and 1000"    ' Set prompt.
            Title = "Add quantity"    ' Set title.
            Default = "1"    ' Set default.
            ' Display message, title, and default value.
            MyValue = InputBox(Message, Title, Default)
                            
            Call oCompDef.DataIO.WriteDataToFile(sOut, oFolder & "\" & oAsmName & "-" & Mid(oFilename, 13) & "-" & MyValue & "pcs" & ".dwg")
        
        
            'just for check its works coretcly
            'i=MessageBox.Show(oDataMedium.FileName, "Title",MessageBoxButtons.OKCancel)
            
            'MessageBox.Show(i,"title",MessageBoxButtons.OK)
        
            'If i=2 Then
        
                'Exit Sub
        
            'End If
    
            oCompDef.FlatPattern.ExitEdit
            
            oDrawDoc.Close
            
        End If
    Next
End Sub
0 Likes
Accepted solutions (1)
1,578 Views
2 Replies
Replies (2)
Message 2 of 3

Sergio.D.Suárez
Mentor
Mentor
Accepted solution

Hi, The code works well for me, I would try to change the following highlighted in red

 

Sub Export_Plasma()

    'define the active document as an assembly file
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument
    
    Dim oAsmName As String
    oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) - 4)
           
    'check that the active document is an assembly file
    If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
        
        MsgBox ("Please run this rule from the assembly file.")
        Exit Sub
        
    End If
    
    'get user input
    result = MsgBox("This will create plasma DWG file for all of the asembly components that are sheet metal." _
    & vbLf & "This rule expects that the part file is saved." _
    & vbLf & " " _
    & vbLf & "Are you sure you want to create plasma DWG for all of the assembly components?" _
    & vbLf & "This could take a minute.", vbYesNo, "This create DWG plasma files ")
    
    If result = vbNo Then
    
        Exit Sub
        
    End If
    
    Dim oPath As String
    Dim iSplit As Integer
    
    iSplit = InStrRev(oAsmDoc.FullDocumentName, "\")
    
    oPath = Left(oAsmDoc.FullDocumentName, iSplit - 1)
     
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
    
    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    
    oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
    
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    
    'get DWG target folder path
    Dim oFolder As String
    oFolder = oPath & "\" & oAsmName & " Plasma Filer"
    
    'Check for the DWG folder and create it if it does not exist
    If Len(Dir(oFolder, vbDirectory)) = 0 Then
        MkDir oFolder
    End If
    '- - - - - - - - - - - - -
    
    '- - - - - - - - - - - - -Component  - - - - - - - - - - - -
    'look at the files referenced by the assembly
    Dim oRefDocs As DocumentsEnumerator
    
    Set oRefDocs = oAsmDoc.AllReferencedDocuments
    
    Dim oRefDoc As Document
    Dim iptPathName As String
    
    'work the the drawing files for the referenced models
    'this expects that the model has been saved
    For Each oRefDoc In oRefDocs
    
        If oRefDoc.DocumentSubType.DocumentSubTypeID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
    
            Dim oDrawDoc As PartDocument
            
            Set oDrawDoc = ThisApplication.Documents.Open(oRefDoc.FullDocumentName, True)
            
           Dim oDef As SheetMetalComponentDefinition
           Set oDef = oDrawDoc.ComponentDefinition

           Dim oThick As String
        oThick = oDef.ActiveSheetMetalStyle.Thickness

        Dim oMaterial As String
        oMaterial = oDrawDoc.ActiveMaterial.DisplayName

         oFolder = oPath & "\" & oAsmName & " Plasma Filer\" & oThick & "-" & oMaterial

        'Check for the DWG folder and create it if it does not exist
         If Len(Dir(oFolder, vbDirectory)) = 0 Then
         MkDir oFolder
          End If
            
            oFilename = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) - 4)
            
            'Set the DWG target file name
            oDataMedium.FileName = oFolder & "\" & oFilename & ".dwg"
        
            Dim oCompDef As SheetMetalComponentDefinition
        
            Set oCompDef = oDrawDoc.ComponentDefinition
            
            If oCompDef.HasFlatPattern = False Then
            
                oCompDef.Unfold
                
            Else
            
             oCompDef.FlatPattern.Edit
             
                                                    
             End If
           
             
        Dim sOut As String
        
       'config
    'Change values located here to change output.
    sOut = "FLAT PATTERN DWG?AcadVersion=2004" _
    & "&OuterProfileLayer=Cut&OuterProfileLayerColor= 0;255;0" _
    & "&InteriorProfilesLayer=Cut&InteriorProfilesLayerColor= 0;255;0" _
    & "&FeatureProfilesLayer=Scribe&FeatureProfilesLayerColor= 255;0;255" _
    & "&FeatureProfilesDownLayer=Scribe&FeatureProfilesDownLayerColor= 255;0;255" _
    & "&InvisibleLayers=IV_BEND;IV_BEND_DOWN;IV_TANGENT;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_UNCONSUMED_SKETCHES;IV_ROLL_TANGENT;IV_ROLL" _
           
'/config
    
            Dim Message, Title, Default, MyValue
            Message = "Enter a value between 1 and 1000"    ' Set prompt.
            Title = "Add quantity"    ' Set title.
            Default = "1"    ' Set default.
            ' Display message, title, and default value.
            MyValue = InputBox(Message, Title, Default)
                            
            Call oCompDef.DataIO.WriteDataToFile(sOut, oFolder & "\" & oAsmName & "-" & Mid(oFilename, 13) & "-" & MyValue & "pcs" & ".dwg")
        
        
            'just for check its works coretcly
            'i=MessageBox.Show(oDataMedium.FileName, "Title",MessageBoxButtons.OKCancel)
            
            'MessageBox.Show(i,"title",MessageBoxButtons.OK)
        
            'If i=2 Then
        
                'Exit Sub
        
            'End If
    
            oCompDef.FlatPattern.ExitEdit
            
            oDrawDoc.Close
            
        End If
    Next
End Sub

Please accept as solution and give likes if applicable.

I am attaching my Upwork profile for specific queries.

Sergio Daniel Suarez
Mechanical Designer

| Upwork Profile | LinkedIn

Message 3 of 3

EMVC
Advocate
Advocate

Hello

Thank you

now it seems working, but when he get so far thats window open to hit quantity he says he also need to hit part number first ?? strange, so instead of hit 1 or 2 etc, hit type in P-4  2 , P-4 for partname 2 for quantityMarek.jpg

0 Likes