Hi romanazaur,
I wasn't able to get the rule to work completely from the part document, I had to create new temporary parts and place them into an assembly and from there run a second rule to create the dxfs. Hardly an ideal solution, but it works.
Here's the code to be run from your sheet metal part:
Imports Excel
Imports Microsoft.Office.Interop.Excel ' To use Excel
Imports System.Runtime.InteropServices ' To use Marshal
Imports System.Activator ' To use CreateInstance
Class ThisRule
Dim app As Inventor.Application
Sub Main()
' Initialize Inventor objects
app = ThisApplication
Dim partDoc As PartDocument = app.ActiveDocument
Dim shtComponentDefinition As SheetMetalComponentDefinition
Dim sheetMetalSubType As String = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
Dim docSubType As String = partDoc.SubType
If docSubType = sheetMetalSubType Then 'sheet metal
shtComponentDefinition = partDoc.ComponentDefinition
Else
MessageBox.Show("This rule should only be run from SheetMetal Parts." & vbLf & _
"", "ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Dim flatPatt As FlatPattern = shtComponentDefinition.FlatPattern
Dim filesToOpen As String = "FilesToOpen"
' Path to the Excel file
Dim excelFilePath As String = "C:\Temp\DXFNameQTY.xlsx" '<<<<change this to match you excel file
' Open Excel
Dim xlApp As Object = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MessageBox.Show("Excel is not installed properly.")
Exit Sub
End If
' Open workbook
Dim xlWorkbook As Object = xlApp.Workbooks.Open(excelFilePath)
Dim xlWorksheet As Object = xlWorkbook.Worksheets(1)
' Determine DXF file path and emboss feature
Dim fileNameWithPath As String = partDoc.FullDocumentName
Dim fileNamePos As Long = InStrRev(fileNameWithPath, "\", -1)
Dim embossFeat As EmbossFeature = shtComponentDefinition.Features.EmbossFeatures.Item(1)
Dim aSideDef As ASideDefinition = flatPatt.ASideFace
Dim tempSketches As New Dictionary(Of String, Object)
Dim oSelectSet As SelectSet = partDoc.SelectSet
' Loop through each row in the Excel file
Dim row As Integer = 1
Do While xlWorksheet.Cells(row, 1).Value IsNot Nothing
Dim partName As String = xlWorksheet.Cells(row, 1).Value.ToString()
Dim quantity As String = xlWorksheet.Cells(row, 2).Value.ToString()
'Create a text user parameter in the part file that will be used for the emboss
Parameter.UpdateAfterChange = True
Parameter("PartName") = partName
Logger.Info("PartName: " & partName)
partDoc.Rebuild2(True)
Dim dxfFileName As String = partName & "_" & quantity & ".dxf"
Dim dxfFilePathOnly As String = Left(fileNameWithPath, fileNamePos)
Dim dxfFilePath As String = dxfFilePathOnly & dxfFileName
Try
flatPatt.Edit()
Catch
' Handle possible error when editing the flat pattern
End Try
Dim faceWithMostEdges As Face = Nothing
Dim faceEdgeCount As Double = 0
For Each ASideFace As Face In flatPatt.Body.Faces'aSideDef.Faces
If ASideFace.Edges.Count > faceEdgeCount Then
faceWithMostEdges = ASideFace
faceEdgeCount = ASideFace.Edges.Count
End If
Next
Dim tempSketch As PlanarSketch = Nothing
' Add sketch to selected face
tempSketch = flatPatt.Sketches.Add(faceWithMostEdges, True)
Dim tempSketchName As String = "TempDXF_Delete" & row
tempSketch.Name = tempSketchName
Dim tempInvFileName As String = partName & "_" & quantity
Dim tempInvFileNamePath As String = dxfFilePathOnly & tempInvFileName & ".ipt"
' Check if the file already exisits, and if it does just tack on a suffix
If System.IO.File.Exists(tempInvFileNamePath) = True Then
tempInvFileNamePath = tempInvFileNamePath.Replace(".", "_1.")
End If
logger.info("tempInvFileNamePath: " & tempInvFileNamePath)
partDoc.SaveAs(tempInvFileNamePath, True)
tempSketches.Add(tempInvFileNamePath, tempSketch)
partDoc.Activate
tempSketch.Delete
flatPatt.ExitEdit
' Proceed to the next row
row += 1
Loop
' Create a temporary assembly to add the temp part files to,
' seems to be the only way to get the System.IO.StreamWriter to clear its memory between export
Dim tempAssemblyDoc As AssemblyDocument = app.Documents.Add(DocumentTypeEnum.kAssemblyDocumentObject, , True)
Dim docComponentDefinition As ComponentDefinition = tempAssemblyDoc.ComponentDefinition
Dim assyDocFileNamePath As String = fileNameWithPath.Replace("ipt", "iam")
' Check if the file already exisits, and if it does just tack on a suffix
If System.IO.File.Exists(assyDocFileNamePath) = True Then
assyDocFileNamePath = assyDocFileNamePath.Replace(".", "_1.")
End If
logger.info("assyDocFileNamePath: " & assyDocFileNamePath)
tempAssemblyDoc.SaveAs(assyDocFileNamePath, False)
tempAssemblyDoc.Activate
PlaceParts(tempSketches, docComponentDefinition)
' Need to close original sheetmetalpart to stop class error from happening
partDoc.Close(False)
' Close the workbook without saving
xlWorkbook.Close(False)
' Quit Excel
xlApp.Quit()
' Clean up
ReleaseObject(xlWorksheet)
ReleaseObject(xlWorkbook)
ReleaseObject(xlApp)
MessageBox.Show("You will now need to Run the Export DXF's rule from this Assembly!", "Finished", _
MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
Public Sub PlaceParts(tempSketches, docComponentDefinition)
Dim fileCount As Integer = 0
fileNameWithPath = ""
intCounter = 0
' Set a reference to the transient geometry object.
Dim transGeometry As TransientGeometry = app.TransientGeometry
' Create a matrix that will be translated/modified multiple times to place the occurrances in different locations
Dim translatedGeometryMatrix As Matrix = transGeometry.CreateMatrix
' Create the original matrix.
Dim transGeometryMatrix As Matrix = transGeometry.CreateMatrix
'Get the plane from the assembly
Dim YZPlane, XZPlane, XYPlane As WorkPlane
Dim selectedOcc As ComponentOccurrence
For Each pair As KeyValuePair(Of String, Object) In tempSketches
Dim fileDlgSelectedFile As String = pair.Key
logger.info("fileDlgSelectedFile: " & fileDlgSelectedFile)
' translate this matrix to the new location
Call transGeometryMatrix.SetTranslation(transGeometry.CreateVector(30, 30, 30))
Call translatedGeometryMatrix.TransformBy(transGeometryMatrix)
Dim oOccurrence As ComponentOccurrence = docComponentDefinition.Occurrences.Add(fileDlgSelectedFile, translatedGeometryMatrix)
Next
End Sub
' Function to release objects
Private Sub ReleaseObject(ByVal obj As Object)
Try
Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
Then after that rule has create the assembly with the temp parts, from the assembly you can run this as an external rule:
' Check with JSC before modifying this rule
'[ ' Exports a dxf of the first sketch for every sheetmetaldocument
Sub Main
app = ThisApplication
If Not app.ActiveEditDocument.DocumentType = kAssemblyDocumentObject Then
MessageBox.Show("This rule should only be run from Assembly files." & vbLf & _
"Run rule only in .iam files!", "WARNING!", _
MessageBoxButtons.OK, MessageBoxIcon.Warning)
Exit Sub
End If
' Set a reference to the active edit document
Dim assemblyDoc As AssemblyDocument = app.ActiveEditDocument
If assemblyDoc.FullFileName = "" Then
MessageBox.Show("Save Assembly Before Running Rule!" & vbLf & _
"", "WARNING!", _
MessageBoxButtons.OK, MessageBoxIcon.Warning)
Exit Sub
End If
' For each document in assembly
For Each tempInvDoc As Document In assemblyDoc.AllReferencedDocuments
' shouldnt really need this as is a brand new assembly with only sheet metal parts
If tempInvDoc.ComponentDefinition.Type = kSheetMetalComponentDefinitionObject Then
Dim fileNameWithPath As String = tempInvDoc.FullDocumentName
Dim fileNamePos As Long = InStrRev(fileNameWithPath, "\", -1)
Dim dxfFileNameWithPath As String = fileNameWithPath.Replace("ipt", "dxf")
Dim tempInvcompDef As SheetMetalComponentDefinition = tempInvDoc.ComponentDefinition
Dim tempInvflatPatt As FlatPattern = tempInvcompDef.FlatPattern
app.Documents.Open(fileNameWithPath, True)
tempInvDoc.Activate
Try
tempInvflatPatt.Edit()
Catch ex As Exception
' Handle possible error when editing the flat pattern
Logger.Info("unable to edit flat pattern" & ex.Message)
End Try
Dim tempInvSketch As PlanarSketch = tempInvflatPatt.Sketches.Item(1)
app.ActiveView.Update()
' Check if the file already exisits, and if it does just tack on a suffix
If System.IO.File.Exists(dxfFileNameWithPath) = True Then
dxfFileNameWithPath = dxfFileNameWithPath.Replace(".", "_1.")
End If
' Write sketch data to a DXF file
tempInvSketch.DataIO.WriteDataToFile("DXF", dxfFileNameWithPath)
Try
tempInvflatPatt.ExitEdit()
Catch ex As Exception
Logger.Info("Error exiting flat pattern edit mode: " & ex.Message)
End Try
End If
Next
MessageBox.Show("Rule Complete, You're Welcome!", "Finished", _
MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub ']j
Hopefully that gets the job done,
James
