VBA Code for exporting SAT files - Help needed from someone with VBA knowledge

[Anonymous]

Hello,

We currently use a simple VBA macro to generate a DXF of a drawing to a specific folder by clicking on a button. We need the same function for creating a SAT file from an IPT (sheet metal part) and I am struggling to make this work. I know it is probably possible with Ilogic but would prefer to just add have this as the same function we have on the DXF.

This would export the IPT as a 3D model (not the flat pattern) to a specified folder and keep the original filename but as *.SAT

The code we use for the DXF export is below. If any VBA experts out there could help with some code for SAT files it would be appreciated.

Thanks

Fred

Sub EXPORT()

Dim invApp As Inventor.Application
Set invApp = ThisApplication
invApp.SilentOperation = True

Dim idwDoc As Inventor.DrawingDocument
Set idwDoc = invApp.ActiveDocument

Dim dxfFile As String
dxfFile = idwDoc.FullFileName
dxfFile = "\\HKEURVAULT\Inventor Resources\DXF_FOR_LAYOUTS\" & idwDoc.DisplayName

Mid(dxfFile, Len(dxfFile) - 3) = ".dxf"

With invApp.CommandManager
Call .PostPrivateEvent(kFileNameEvent, dxfFile)
Call .StartCommand(kFileSaveCopyAsCommand)
End With

Set idwDoc = Nothing
invApp.SilentOperation = False
Set invApp = Nothing

End Sub

[bradeneuropeArthur]

 Public Sub ExportToSat()

        Set m_invApp = ThisApplication
        Dim oSATTrans As TranslatorAddIn

        Set oSATTrans = m_invApp.ApplicationAddIns.ItemById("{89162634-02B6-11D5-8E80-0010B541CD80}")

        If oSATTrans Is Nothing Then
        Exit Sub
        End If

        Dim oContext As TranslationContext
        Set oContext = m_invApp.TransientObjects.CreateTranslationContext
        Dim oOptions As NameValueMap
        Set oOptions = m_invApp.TransientObjects.CreateNameValueMap

        If oSATTrans.HasSaveCopyAsOptions(m_invApp.ActiveDocument, oContext, oOptions) Then

            oOptions.Value("ExportUnits") = 5

            oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism

            Dim oData As DataMedium

            Set oData = m_invApp.TransientObjects.CreateDataMedium
            
            Dim oSatFileName As String
            
            oSatFileName = Replace(m_invApp.ActiveDocument.FullFileName, ".ipt", ".sat") ' ipt to sat
            On Error Resume Next
    
            MkDir ("\\hkeurvault\SAT_FILES\")
            
            Err.Clear
            
            oData.FileName = "\\hkeurvault\SAT_FILES\" & oSatFileName

            Call oSATTrans.SaveCopyAs(m_invApp.ActiveDocument, oContext, oOptions, oData)

        End If

    End Sub

[Anonymous]

Still same error? See attached

[bradeneuropeArthur · Accepted solution]

Sorry, but I have copied to fast.

I am working along different projects and forgot to second check it.

Hope this will work now!!

  Public Sub ExportToSat()

        Set m_invApp = ThisApplication
        Dim oSATTrans As TranslatorAddIn

        Set oSATTrans = m_invApp.ApplicationAddIns.ItemById("{89162634-02B6-11D5-8E80-0010B541CD80}")

        If oSATTrans Is Nothing Then
        Exit Sub
        End If

        Dim oContext As TranslationContext
        Set oContext = m_invApp.TransientObjects.CreateTranslationContext
        Dim oOptions As NameValueMap
        Set oOptions = m_invApp.TransientObjects.CreateNameValueMap

        If oSATTrans.HasSaveCopyAsOptions(m_invApp.ActiveDocument, oContext, oOptions) Then

            oOptions.Value("ExportUnits") = 5

            oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism

            Dim oData As DataMedium

            Set oData = m_invApp.TransientObjects.CreateDataMedium
            
            Dim oSatFileName As String

            oSatFileName = Replace(m_invApp.ActiveDocument.DisplayName, ".ipt", ".sat") ' ipt to sat
            
            MsgBox oSatFileName
            On Error Resume Next
    
            MkDir ("\\hkeurvault\SAT_FILES\")
            
            Err.Clear
            
            oData.FileName = "\\hkeurvault\SAT_FILES\" & oSatFileName

            Call oSATTrans.SaveCopyAs(m_invApp.ActiveDocument, oContext, oOptions, oData)

        End If

    End Sub

[Anonymous]

Worked perfectly thanks

Please don't apologise, I really appreciate your help

[bradeneuropeArthur]

Took some time, but with succes.

Your thanks are appreciated too...

if any help is required please don't hesitate.

Regards,

! For administrative reasons, please mark a "Solution as solved" when the issue is solved !