Guten Morgen zusammen,
ich bin dabei ein Makro anzupassen, welches aus der Zeichnungsebene ein Step ausspeichert. Das Step wird auch erzeugt ist aber leer?
Was habe ich übersehen? Über eine Hilfe würde ich mich freuen - Danke schon mal im voraus
Sub Export_Step()
'Referenz zu Aktiven Dokument setzen
Dim oDoc As Inventor.Document
Set oDoc = ThisApplication.ActiveDocument
Set oDef = oDoc.ReferencedDocuments.Item(1)
'Iprops lesen
Dim oProp As Property
Dim sPropValue As String
For Each oProp In oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
If oProp.Name = "Artikel-Nr." Then
'If oProp.Name = "Anzeigename" Then
'sPropValue1 = Left(oProp.Value, 12)
sPropValue1 = oProp.Value
End If
Next
For Each oProp In oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
Dim sPropValue2 As String
If oProp.Name = "Index" Then
sPropValue2 = oProp.Value
End If
Next
'STEP translator Add-In setzen
Dim oSTEPTranslator As TranslatorAddIn
Set oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
If oSTEPTranslator Is Nothing Then
MsgBox "STEP Translater nicht aufrufbar."
Exit Sub
End If
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
'Optionen Export Step setzen
' 2 = AP 203 - Configuration Controlled Design
' 3 = AP 214 - Automotive Design
oOptions.Value("ApplicationProtocolType") = 3
oContext.Type = kFileBrowseIOMechanism
Dim oData As DataMedium
Set oData = ThisApplication.TransientObjects.CreateDataMedium
'oData.filename = "C:\Exchange\" & sPropValue1 & ".stp"
oData.filename = "C:\Exchange\" & sPropValue1 & "_" & sPropValue2 & ".stp"
'Bestehende Versionen im Pfad löschen
Dim sFileName As String
sFileName = Dir("C:\Exchange\" & sPropValue1 & "_" & "*.stp")
Do While sFileName <> ""
Kill "C:\Exchange\" & sFileName
sFileName = Dir
Loop
Call oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
End If
End Sub
------------------
MFG
BlueJay
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP