[iLogic] Exporter des IPT en DWG

[ThomasB44]

Bonjour, j'ai besoin d'automatiser les tâches suivantes :

1. Demander à l'utilisateur l'emplacement d'un répertoire
2. Ouvrir un à un les fichiers commençant par "BLOC", et dont l'extension est "IPT"
3. Lancer la commande "Reconstruire"
4. Lancer la commande "Mettre à jour"
5. Activer la représentation de vue "Master"
6. Mettre à jour les matériaux
7. Mettre à jour les apparences
8. Purger les styles inutilisés (matériaux et apparences)
9. Sauvegarder en DWG 3D

[ThomasB44 · Accepted solution]

Ci-dessous, le code associé à cette demande, avec en bonus la barre de progression Inventor

'''Cette règle ouvre les fichiers suivant ce filtre : "BLOC*.ipt"
'''Dans un emplacement unique choisi par l'utilisateur
'''Puis réalise les actions suivantes :
'''Ouvre les fichiers un à un
'''Reconstruit
'''Mets à jour
'''Règle la représentation de vue sur : "Master"
'''Mets à jour les matériaux
'''Mets à jour les styles
'''Purge les styles
'''Exporte en DWG, au même emplacement
'''Sauvegarde et ferme

Sub Main
'Start of rule
If MessageBox.Show("Cette règle va sauvegarder en DWG chaque fichier nommé :" _
& vbNewLine & Chr(34) & "BLOC*" & Chr(34) _
& " avec l'extension " & Chr(34) & "IPT" & Chr(34) & " dans un répertoire unique." _
& vbNewLine & "Voulez vous continuer ?", "iLogic", _
MessageBoxButtons.YesNo, MessageBoxIcon.Question) = vbNo Then Return

'Declare variables
Dim oPath As String
'[ Choose the directory
Dim Dialog = New FolderBrowserDialog() 'Define folder browser dialog
Dialog.SelectedPath = "P:\DESSIN\BLOCS\"
Dialog.ShowNewFolderButton = True 'Set options for folder browser dialog
Dialog.Description = "Choisir un répertoire :"
If DialogResult.OK = Dialog.ShowDialog() Then 'User clicked OK
    oPath = Dialog.SelectedPath & "\" 'Capture the export path
Else 'User clicked cancel
    Return 'exit
End If ']

'[ Filter files
Dim i, iCount As Integer
i = 0
iCount = 0
oFiles = System.IO.Directory.GetFiles(oPath, "BLOC*.ipt", _
System.IO.SearchOption.TopDirectoryOnly)
For Each oFile In oFiles
	iCount = iCount + 1
Next']

'[ Create a progress bar
Dim oProgressBar As Inventor.ProgressBar
oMessage = "Creation du DWG... "
oProgressBar = ThisApplication.CreateProgressBar(False, iCount, oMessage)
']

'Loop through each file and process actions
For Each oFile In oFiles
	'[ Iterate progress bar
	i = i + 1
	oProgressBar.Message = _
	("Traitement de la pièce : " & i & "/" & iCount & vbNewLine & "Fichier : " & oFile)
	oProgressBar.UpdateProgress']
	oDoc = ThisApplication.Documents.Open(oFile)
	oDoc.Rebuild
	oDoc.Update
	SetDefaultView(oFile)
	UpdateMat(oFile)
	UpdateStyle(oFile)
	PurgeStyle(oFile)
	SaveAsDWG3D(oFile)
	oDoc.Save
	oDoc.Close
Next

'[ End of the rule
oProgressBar.Close
MessageBox.Show(i & " fichiers créés en DWG." _
& vbNewLine & "A cette adresse : " & oPath _
, "iLogic", MessageBoxButtons.OkCancel, MessageBoxIcon.Asterisk, _
MessageBoxDefaultButton.Button1)']
End Sub

Function SaveAsDWG3D(oFile As String)
    'Get the DWG translator Add-In. 
    Dim DWGAddIn As TranslatorAddIn
    DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")
    'Get the active document
    Dim oDoc As Document
    oDoc = ThisApplication.ActiveDocument
    Dim TransObjs As TransientObjects
    TransObjs = ThisApplication.TransientObjects
    'Set up the context to define an output file.
    Dim oContext As TranslationContext
    oContext = TransObjs.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism
    'Get the available options from the translator.
    Dim oOptions As NameValueMap
    oOptions = TransObjs.CreateNameValueMap
    If DWGAddIn.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
        'Set the options for what types of data to write out. 
        oOptions.Value("Solid") = True      'Output solids. 
        oOptions.Value("Surface") = False   'Output surfaces. 
        oOptions.Value("Sketch") = False    'Output sketches.
        'Set the DWG version.
        '23 = ACAD 2000
        '25 = ACAD 2004
        '27 = ACAD 2007
        '29 = ACAD 2010 
        oOptions.Value("DwgVersion") = 29
    End If
    'Set the output filename, using a DataMedium object.
    Dim oDataMedium As DataMedium
    oDataMedium = TransObjs.CreateDataMedium
    oDataMedium.FileName = Left(oFile, Len(oFile) -3) & "dwg"
    'Call the SaveCopyAs method of the translator add-in.
    Call DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
End Function

Function SetDefaultView(oFile As String)
	oDoc = ThisApplication.Documents.Open(oFile)
	Dim oDef As PartComponentDefinition
  	oDef = oDoc.ComponentDefinition
	Dim oRepMgr As RepresentationsManager
  	oRepMgr = oDef.RepresentationsManager
	Dim oViewReps As DesignViewRepresentations
  	oViewReps = oRepMgr.DesignViewRepresentations
	Dim oView As DesignViewRepresentation
	oView = oViewReps.Item("Master")
	oView.Activate
End Function

Function UpdateMat(oFile As String)
	oDoc = ThisApplication.Documents.Open(oFile)
	Dim oDef As PartComponentDefinition
  	oDef = oDoc.ComponentDefinition
	oDef.Material.UpdateFromGlobal
End Function

Function UpdateStyle(oFile As String)
	oDoc = ThisApplication.Documents.Open(oFile)
	For i = 1 To oDoc.RenderStyles.Count
		If oDoc.RenderStyles.Item(i).UpToDate = False Then
			oDoc.RenderStyles.Item(i).UpdateFromGlobal
		End If
	Next
End Function

Function PurgeStyle(oFile As String)
	oDoc = ThisApplication.Documents.Open(oFile)
	Dim foundUnused As Boolean
	Do
		foundUnused = False
		Dim a As Asset
		For Each a In oDoc.Assets
			If Not a.IsUsed Then
			a.Delete
			foundUnused = True
			End If
		Next
	Loop While foundUnused
End Function