Export Macro .stl Select Several Parts

[nico]

Ellowah

You know the feeling, time to 3D print all those parts for a prototype but you need to activate each part and do an export to .stl for printing and it takes a while if you have a lot of small parts, hoping you got them all in the end.

The reason I'm writing this piece of code; it's almost finished but I need a way to "Store" the selected objects in an "array" while I'm still selecting parts to pull them out afterwords in the correct order/filename for automatic export

Dim oTranslator As TranslatorAddIn
Dim oDocument As Document
Dim oContext As TranslationContext
Dim oDataMedium As DataMedium
Dim oOptions As NameValueMap

Dim oSelection As Object 
Dim sSelection As String
Dim aSelectionArray As New ArrayList
Dim Counter As Integer
Dim lPos As Long
Dim sLen As Long
Dim sFileName As String
	
	oTranslator = ThisApplication.ApplicationAddIns.ItemById("{533E9A98-FC3B-11D4-8E7E-0010B541CD80}")
	oDocument = ThisApplication.ActiveDocument
	oContext = ThisApplication.TransientObjects.CreateTranslationContext	
	oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
	oOptions = ThisApplication.TransientObjects.CreateNameValueMap

	If oTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
			oOptions.Value("ExportUnits") = 5 'Millimeter
			oOptions.Value("Resolution") = 0 'High
			oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	End If

		STLPath = "C:\$Working Folder\Designs\9000 - Export Macro - STL"

Counter = "0"

While Counter < "3"
	'iLogicForm.Show("Selection Box", FormMode.NonModal)
	
	oSelection = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select Part")
	sSelection = oSelection.Name
	
	'Find the File Name
		'Find the seperator in the File Name:number
			lPos = InStr(sSelection, ":")
		'Find the number of characters in the File Name
			sLen = Len(sSelection)
		'Find the File Name
			sFileName = Left(sSelection, lPos -1)
	
	oDataMedium.FileName = STLPath & "\" & sFileName & ".stl"
	aSelectionArray.Add(oDataMedium.FileName)
		
	Counter = Counter + "1"
End While

For Each Item In aSelectionArray 
		oDataMedium.FileName = Item
		oTranslator.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
Next

'Publish document
	Folder = MessageBox.Show("Export STL" & vbLf & "Terug te vinden in:" & vbLf & STLPath & vbLf & vbLf &"Open File Location?","Confirmation & Open Folder?",MessageBoxButtons.YesNo,MessageBoxIcon.Question)
	
	If Folder = vbYes Then
		Shell("explorer.exe " & STLPath,vbNormalFocus)
	End If

To Test you'll need 3 parts atm or change the counter, this is supposed to become an automatic counter later on with a forum to stop or undo an added item, hence the counter for the time being

Any1 who knows how to save objects this way?

[AlexFielder]

It sounds like you're looking for an ObjectCollection:

http://help.autodesk.com/view/INVNTOR/2019/ENU/?guid=GUID-6C4C98CB-8909-48EF-B73E-F663424D5B41

(there are some vba samples at the bottom of that ^ page)

Or, failing that you can use a simple .NET list (Of in this case FileInfo):

Dim drawingfiles As List(Of FileInfo) = Nothing

Found in the wild here:

Option Explicit On
Imports System.io
Imports System.LINQ

Sub Main
Dim extensions As String() = {".dwg", ".idw"}
    Dim defaultDrawingExtension = ".idw" ' ".dwg"
    Dim dir As DirectoryInfo = Nothing
    Dim JustDoIt As Boolean = True
    Dim newPDFName As String = ""
    Dim trimmedfilename As String = ""
    Dim drawingfiles As List(Of FileInfo) = Nothing

    'check that the active document is an assembly file
    If ThisApplication.ActiveDocument.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
        MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
        Exit Sub
    End If

    'define the active document as an assembly file
    Dim oAsmDoc As AssemblyDocument
    oAsmDoc = ThisApplication.ActiveDocument
    Dim oAsmName As String = System.IO.Path.GetFileNameWithoutExtension(oAsmDoc.FullFileName) 'Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)
    'MessageBox.Show(oAsmName)
    'get user input
    Dim RUsure As DialogResult = MessageBox.Show(
    "This will create a PDF file for all of the assembly components that have drawing files." _
    & vbLf & "This rule expects that the drawing file shares the same name and location as the component." _
    & vbLf & " " _
    & vbLf & "Are you sure you want to create PDF Drawings for all of the assembly components?" _
    & vbLf & "This could take a while.", "iLogic  - Batch Output PDFs ", MessageBoxButtons.YesNo)

    If RUsure = vbNo Then
        Exit Sub
    End If
    'MessageBox.Show("Continuing")
    '- - - - - - - - - - - - -PDF setup - - - - - - - - - - - -
    Dim oPath As String = ThisDoc.Path
    Dim PDFAddIn As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
    Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
    Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
    Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
    'MessageBox.Show("Continuing")
    If PDFAddIn.HasSaveCopyAsOptions(oAsmDoc, oContext, oOptions) Then
        oOptions.Value("All_Color_AS_Black") = 0
        'oOptions.Value("Remove_Line_Weights") = 0
        'oOptions.Value("Vector_Resolution") = 400
        oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4
    End If
    'MessageBox.Show("Continuing")
    'get PDF target folder path
    Dim oFolder As String = System.IO.Path.GetDirectoryName(oAsmDoc.FullFileName) & "\" & oAsmName & " PDF Files"
    MessageBox.Show("Looking for: " & oFolder & " & Creating it if it doesn't already exist!")
    'Check for the PDF folder and create it if it does not exist
    If Not System.IO.Directory.Exists(oFolder) Then
        System.IO.Directory.CreateDirectory(oFolder)
    End If
    '- - - - - - - - - - - - -

    '- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -
    'look at the files referenced by the assembly
    Dim oRefDocs As DocumentsEnumerator
    oRefDocs = oAsmDoc.AllReferencedDocuments
    Dim oRefDoc As Document

    For Each oRefDoc In oRefDocs
        Dim filename As String = oRefDoc.FullDocumentName
        Dim ThisFileDir As String = System.IO.Path.GetDirectoryName(oRefDoc.FullDocumentName)
        If Not JustDoIt Then
            RUsure = MessageBox.Show(filename, "PDF This file?", MessageBoxButtons.YesNo)
            If RUsure = vbNo Then
                Continue For
            End If
        End If
        dir = New DirectoryInfo(ThisFileDir)
        trimmedfilename = System.IO.Path.GetFileNameWithoutExtension(filename)
        drawingfiles = GetFilesByExtensions(dir, trimmedfilename, extensions)
        If drawingfiles.Count = 1 Then
            Dim oDrawDoc As DrawingDocument
            oDrawDoc = ThisApplication.Documents.Open(drawingfiles.Item(0).FullName, True)
            Dim oFileName As String = System.IO.Path.GetFileNameWithoutExtension(oRefDoc.DisplayName)
            newPDFName = oFolder & "\" & oFileName & ".pdf"
            If System.IO.File.Exists(newPDFName) Then
                If CheckReadOnly(newPDFName) Then
                    MessageBox.Show("PDF Exists and is read only," & vbCrLf & "Suggest you close it or check it out of Vault!" & vbCrLf & "before trying this rule again!")
                    Exit Sub
                End If
            End If
            oDataMedium.FileName = newPDFName
            Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
            oDrawDoc.Close()
        ElseIf drawingfiles.Count > 1 Then
            MessageBox.Show("We found multiple format drawing files!" & vbCrLf & "Please correct this before trying again!")
        ElseIf drawingfiles.Count = 0 Then
            ThisApplication.StatusBarText = "No Matching drawing file found for: " & filename
        End If
    Next
    '- - - - - - - - - - - - -

    '- - - - - - - - - - - - -Top Level Drawing - - - - - - - - - - - -
    Dim assyfilename As String = oAsmDoc.FullFileName
    Dim assyFileDir As String = System.IO.Path.GetDirectoryName(oAsmDoc.FullFileName)
    dir = New DirectoryInfo(assyFileDir)
    trimmedfilename = System.IO.Path.GetFileNameWithoutExtension(assyfilename)
    drawingfiles = GetFilesByExtensions(dir, trimmedfilename, extensions)
    If drawingfiles.Count = 1 Then
        Dim oAsmDrawingDoc As DrawingDocument = ThisApplication.Documents.Open(drawingfiles.Item(0).FullName, True)
        Dim oAsmDrawingName As String = System.IO.Path.GetFileNameWithoutExtension(oAsmDrawingDoc.FullFileName)
        newPDFName = oFolder & "\" & oAsmDrawingName & ".pdf"
        oDataMedium.FileName = newPDFName
        If System.IO.File.Exists(newPDFName) Then
            If CheckReadOnly(newPDFName) Then
                MessageBox.Show("PDF Exists and is read only," & vbCrLf & "Suggest you close it or check it out of Vault!" & vbCrLf & "before trying this rule again!")
                Exit Sub
            Else
                Call PDFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)
            End If
        Else
            Call PDFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)
        End If

        'Close the top level drawing
        oAsmDrawingDoc.Close()

    End If
    '- - - - - - - - - - - - -

    'MessageBox.Show("New Files Created in: " & vbLf & oFolder, "iLogic")
    'open the folder where the new ffiles are saved
    Shell("explorer.exe " & oFolder, vbNormalFocus)
End Sub

Public Function GetFilesByExtensions(dir As DirectoryInfo, filename As String, ParamArray extensions As String()) As List(Of FileInfo)
    If extensions Is Nothing Then
        Throw New ArgumentNullException("extensions")
    End If
    Dim files = dir.EnumerateFiles("*.*", SearchOption.AllDirectories).Where(Function(s As FileInfo) Not (s.FullName.Contains("OldVersions")) And (System.IO.Path.GetFileNameWithoutExtension(s.FullName).ToLower() = filename.ToLower()))
    'Dim files = dir.EnumerateFiles("*.*", SearchOption.AllDirectories).Where(Function(s As FileInfo) Not (s.FullName.Contains("-")) And Not (s.FullName.contains("OldVersions")))
    Return files.Where(Function(f As FileInfo) extensions.Contains(f.Extension)).OrderBy(Function(x As FileInfo) x.Name).ToList()
End Function

Public Shared Function CheckReadOnly(ByVal doc As String) As Boolean
    Try
        ' Handle the case with the active document never saved
        If System.IO.File.Exists(doc) = False Then
            MessageBox.Show("Save file before executing this method. Exiting ...")
            Return False
        End If

        Dim atts As System.IO.FileAttributes = IO.File.GetAttributes(doc)

        If ((atts And System.IO.FileAttributes.ReadOnly) = System.IO.FileAttributes.ReadOnly) Then
            Return True
        Else
            'The file is Read/Write
            Return False
        End If
    Catch ex As Exception
        MessageBox.Show(ex.Message)
        Return False
    End Try
End Function

🙂