Option Explicit

Private oDoc As Document

Public Sub SaveasDwg()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> kDrawingDocumentObject Then
Exit Sub
End If
Dim addIns As ApplicationAddIns

Set addIns = oDoc.Parent.ApplicationAddIns

Dim dwgAddIn As TranslatorAddIn
Dim i As Integer
For i = 1 To addIns.Count
If addIns(i).AddInType = kTranslationApplicationAddIn Then
If addIns(i).Description = "Autodesk Internal DWG Translator" Then
Set dwgAddIn = addIns.Item(i)
Exit For
End If
End If
Next i

'Activate AddIns
dwgAddIn.Activate
Dim fname As String
fname = oDoc.FullFileName
fname = Left(fname, Len(fname) - 3) & "dwg"
Dim iPath As Integer
Dim sPath As String
iPath = InStrRev(fname, "\")
sPath = Left(fname, iPath)
Call createDWG(oDoc.Parent, dwgAddIn, fname, sPath)

End Sub


Private Sub createDWG(oApp As Object, dwgAddIn As TranslatorAddIn, fname As String, sPath As String)

Dim map As NameValueMap
Dim context As TranslationContext
Dim trans As TransientObjects
Set trans = oApp.TransientObjects
Set map = trans.CreateNameValueMap
Set context = trans.CreateTranslationContext
context.Type = kFileBrowseIOMechanism
Dim b As Boolean
Dim file As DataMedium
Set file = trans.CreateDataMedium

b = dwgAddIn.HasSaveCopyAsOptions(file, context, map)

file.FileName = fname
'specify ini file from where the setting will be pickup

map.Value("Export_Acad_IniFile") = sPath & "dwgconfig.ini"
dwgAddIn.SaveCopyAs oApp.ActiveDocument, context, map, file

End Sub

Public Sub SaveAsDXF()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> kDrawingDocumentObject Then
Exit Sub
End If
Dim addIns As ApplicationAddIns

Set addIns = oDoc.Parent.ApplicationAddIns

Dim dxfAddIn As TranslatorAddIn
Dim i As Integer
For i = 1 To addIns.Count
If addIns(i).AddInType = kTranslationApplicationAddIn Then
If addIns(i).Description = "Autodesk Internal DXF Translator" Then
Set dxfAddIn = addIns.Item(i)
Exit For
End If
End If
Next i

'Activate AddIns
dxfAddIn.Activate
Dim fname As String
fname = oDoc.FullFileName
fname = Left(fname, Len(fname) - 3) & "dxf"
Dim iPath As Integer
Dim sPath As String
iPath = InStrRev(fname, "\")
sPath = Left(fname, iPath)
Call createDXF(oDoc.Parent, dxfAddIn, fname, sPath)
Close (False)


End Sub

Private Sub createDXF(oApp As Object, dxfAddIn As TranslatorAddIn, fname As String, sPath As String)

Dim map As NameValueMap
Dim context As TranslationContext
Dim trans As TransientObjects
Set trans = oApp.TransientObjects
Set map = trans.CreateNameValueMap
Set context = trans.CreateTranslationContext
context.Type = kFileBrowseIOMechanism
Dim b As Boolean
Dim file As DataMedium
Set file = trans.CreateDataMedium

b = dxfAddIn.HasSaveCopyAsOptions(file, context, map)

file.FileName = fname
'specify ini file from where the setting will be pickup

'map.Value("Export_Acad_IniFile") = sPath & "dxfconfig.ini"
dxfAddIn.SaveCopyAs oApp.ActiveDocument, context, map, file

End Sub

Public Sub SaveAsBMP()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 And _
oDoc.DocumentType <> 12291 And _
oDoc.DocumentType <> 12292 And _
oDoc.DocumentType <> 12293 Then
Exit Sub
End If

Saveas "bmp"


End Sub

Public Sub SaveAsDWF()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12292 Then
Exit Sub
End If

Saveas "dwf"

End Sub

Public Sub SaveAsDWP()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12292 Then
Exit Sub
End If

Saveas "dwp"

End Sub

Public Sub SaveAsXML()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 And _
oDoc.DocumentType <> 12291 And _
oDoc.DocumentType <> 12292 And _
oDoc.DocumentType <> 12293 Then
Exit Sub
End If

Saveas "xml"

End Sub

Public Sub SaveAsIGS()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 And _
oDoc.DocumentType <> 12291 Then
Exit Sub
End If

Saveas "igs"

End Sub

Public Sub SaveAsSAT()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 And _
oDoc.DocumentType <> 12291 Then
Exit Sub
End If

Saveas "sat"

End Sub

Public Sub SaveAsSTP()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 And _
oDoc.DocumentType <> 12291 Then
Exit Sub
End If

Saveas "stp"

End Sub

Public Sub SaveAsSTL()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 Then
Exit Sub
End If

Saveas "stl"

End Sub

Public Sub SaveAsPTP()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 Then
Exit Sub
End If

Saveas "ptp"

End Sub

Public Sub SaveAsXGL()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 And _
oDoc.DocumentType <> 12291 Then
Exit Sub
End If

Saveas "xgl"

End Sub

Public Sub SaveAsZGL()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12290 And _
oDoc.DocumentType <> 12291 Then
Exit Sub
End If

Saveas "zgl"
:)
End Sub

Public Sub SaveAsAMP()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12291 Then
Exit Sub
End If

Saveas "amp"

End Sub

Public Sub SaveAsPNP()

Set oDoc = ThisApplication.ActiveDocument

If oDoc.DocumentType <> 12293 Then
Exit Sub
End If

Saveas "pnp"

End Sub

save as?... j'ai pas toute lus.. mais en resumé il fait quoi de plus?..

salut

avec ce code, tu peux te créé un bouton pour tout sorte de Save As.... il vas exporté ta piece ou assemblage en fichier SAT ou DWG ou ect.... dans le meme dossier ou ce trouve le fichier original.....

rentrez ce code dans le VBA ensuite créé vous une image de 16px par 16px dans le dossier (\Autodesk\Inventor 2009\Bin\Macros) nommé la comme suis...
(SaveAs_Open.SaveAsSAT.Small.bmp)

SaveAs ; es le nom du module VBA (par défault module.1)
SaveAsSat ; est le nom de la macro
Small veux dire que c'est l'image de l'icone

il reste ensuite a chercher l'icone dans customize....


Maccam