Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
petr.meduna
in reply to: m.rymut

Try this:

 

Public Sub Main()
	Dim ass As AssemblyDocument = ThisApplication.ActiveDocument
	Dim RutaExport As String = ThisDoc.Path
	Dim Dialog = New FolderBrowserDialog()
	Dialog.SelectedPath = RutaExport
	Dialog.ShowNewFolderButton = True
	Dialog.Description = "Choose directory for saved .stp files"
	Dialog.ShowDialog()
	If DialogResult.OK Then
		oPath = Dialog.SelectedPath & "\"
	Else
		Return
	End If
	Dim oselset As SelectSet = ass.SelectSet
	Dim i As Integer = 0
	Dim result As Boolean
	Dim occ As ComponentOccurrence
	If oselset.Count <> 0 Then
		For Each occ In oselset
			Dim doc As Document = occ.Definition.Document
			result = ExportToSTEP(doc, oPath)
			If result = True Then
				i = i + 1
			End If
		Next
		MessageBox.Show(i & " files successfully exported", "result")
	Else
		MessageBox.Show("You must select files to export before running rule", "Error")
	End If
End Sub

Function ExportToSTEP(doc As Document, sPath As String) As Boolean
	Dim oSTEPTranslator As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
	Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	If oSTEPTranslator.HasSaveCopyAsOptions(doc, oContext, oOptions) Then
		oOptions.Value("ApplicationProtocolType") = 3
		oContext.Type = kFileBrowseIOMechanism
		Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
		uPath = Left(doc.FullDocumentName, InStrRev(doc.FullDocumentName, "\") -1)
		uName = Mid(doc.FullDocumentName, Len(uPath) + 2, Len(doc.FullDocumentName) -Len(uPath) -5)
		oData.FileName = sPath & uName & ".stp" 
		Call oSTEPTranslator.SaveCopyAs(doc, oContext, oOptions, oData)
		ExportToSTEP = True
	End If
End Function