Sub Main()
' Check if the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("This rule can only run from an Assembly file.", "DXF-
creator", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
' Dim the active document as AssemblyDocument
Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
' Ensure the assembly is saved
If oDoc.FullFileName = "" Then
MessageBox.Show("Please save the Assembly before running this rule.", "DXF-
creator", MessageBoxButtons.OK, MessageBoxIcon.Information)
Exit Sub
End If
' Get assembly name and path
Dim oAsmName As String =
System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
Dim oPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName)
' Get the Parts Only BOM
Dim oBOM As BOM = oDoc.ComponentDefinition.BOM
oBOM.PartsOnlyViewEnabled = True
Dim oBOMview As BOMView = oBOM.BOMViews.Item(oBOM.BOMViews.Count)
' Set references for later use
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oX As Double = 0
Dim oY As Double = 0
Dim oBaseViewOptions As NameValueMap =
ThisApplication.TransientObjects.CreateNameValueMap
oBaseViewOptions.Add("SheetMetalFoldedModel", False)
Dim oDrawing As DrawingDocument = Nothing
Dim unsavedSmParts As String = ""
Dim i As Integer = 1
Dim oInfo As String = ""
' Traverse the Parts Only BOM
For Each oRow As BOMRow In oBOMview.BOMRows
Try
Dim oDef As ComponentDefinition = oRow.ComponentDefinitions(1)
If TypeOf oDef Is SheetMetalComponentDefinition Then
Dim smPartDoc As PartDocument = oDef.Document
If smPartDoc.FullFileName = "" Then
If unsavedSmParts = "" Then
unsavedSmParts = "The following SM-documents were not
saved and no drawing views were created:" & vbCrLf
End If
unsavedSmParts &= vbCrLf & oDef.Document.DisplayName
Continue For
End If
' Ensure flat pattern exists
Dim smCompDef As SheetMetalComponentDefinition = oDef
If Not smCompDef.HasFlatPattern Then
smCompDef.Unfold()
smCompDef.FlatPattern.ExitEdit()
End If
' Validate the Description property
Dim Description As String = smPartDoc.PropertySets("Design
Tracking Properties").Item("Description").Value
If InStr(1, Description, "OUTER_COVER", vbTextCompare) = 0 And _
InStr(1, Description, "INNER_COVER", vbTextCompare) = 0
Continue For
End If
' Adjust flat pattern orientation based on material
Dim Material As String =
smCompDef.Parameters.UserParameters.Item("Material").Value
Dim Orien As FlatPatternOrientation =
smCompDef.FlatPattern.FlatPatternOrientations.Item(1)
If Material = "GI" Or Material = "GIPC" Then
If Description = "OUTER_COVER" Then
Orien.FlipBaseFace = False
Orien.FlipAlignmentAxis = False
Orien.AlignmentRotation.Expression = "90 deg"
ElseIf Description = "INNER_COVER" Then
Orien.FlipBaseFace = False
Orien.FlipAlignmentAxis = True
Orien.AlignmentRotation.Expression = "90 deg"
End If
ElseIf Material = "SS" Or Material = "PCS" Then
If Description = "OUTER_COVER" Then
Orien.FlipBaseFace = True
Orien.FlipAlignmentAxis = True
Orien.AlignmentRotation.Expression = "90 deg"
ElseIf Description = "INNER_COVER" Then
Orien.FlipBaseFace = True
Orien.FlipAlignmentAxis = False
Orien.AlignmentRotation.Expression = "90 deg"
End If
End If
' Create the drawing if not already created
If oDrawing Is Nothing Then
oDrawing =
ThisApplication.Documents.Add(DocumentTypeEnum.kDrawingDocumentObject, , False)
oDrawing.UnitsOfMeasure.LengthUnits =
oDoc.UnitsOfMeasure.LengthUnits
End If
' Add the flat pattern view to the drawing
Dim oSheet As Sheet = oDrawing.ActiveSheet
Dim oView As DrawingView =
oSheet.DrawingViews.AddBaseView(smPartDoc, oTG.CreatePoint2d(oX, oY), 1, _
ViewOrientationTypeEnum.kDefaultViewOrientation,
DrawingViewStyleEnum.kHiddenLineRemovedDrawingViewStyle, _
"FlatPattern", , oBaseViewOptions)
oView.Name = smPartDoc.DisplayName
oView.ShowLabel = True
oView.Position = oTG.CreatePoint2d(oView.Position.X + oView.Width
/ 2, oView.Position.Y)
oX = oView.Left + oView.Width + 5
RemoveBendLines(oView, smCompDef.FlatPattern)
' Update info and close part
oInfo &= If (i = 1, "", vbCrLf) & i & ". " &
smPartDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
i += 1
smPartDoc.Close(True)
End If
Catch Ex As Exception
MsgBox(Ex.Message)
End Try
Next
' Save drawing and DXF if created
If oDrawing IsNot Nothing Then
Dim oDXFName As String = oPath & "\" & oAsmName & "_FlatPatterns.dxf"
Dim oINI As String = "C:\iLogic External Rules\DXFExport.ini"
If oINI = "" Then
MessageBox.Show("You need to specify an INI file location in the
code.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
SaveDXF(oDrawing, oDXFName, oINI)
Dim oInfoName As String = oPath & "\" & oAsmName & "_FlatPatterns.txt"
CreateTXT(oInfo, oInfoName)
End If
' Return unsaved parts information
If unsavedSmParts <> "" Then
MessageBox.Show(unsavedSmParts, "Some parts were not saved",
MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
If oDrawing IsNot Nothing Then oDrawing.Close()
oDoc.Update()
End Sub
' Save DXF subroutine
Sub SaveDXF(oDrawing As DrawingDocument, oFileName As String, oIniFile As String)
Dim DXFAddIn As TranslatorAddIn =
ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-
0010B541CD80}")
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
If DXFAddIn.HasSaveCopyAsOptions(oDrawing, oContext, oOptions) Then
oOptions.Value("Export_Acad_IniFile") = oIniFile
End If
oDataMedium.FileName = oFileName
Try
DXFAddIn.SaveCopyAs(oDrawing, oContext, oOptions, oDataMedium)
MessageBox.Show("DXF saved to: " & oFileName, "DXF Saved",
MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch
MessageBox.Show("Couldn't save DXF!", "Error", MessageBoxButtons.OK,
MessageBoxIcon.Error)
End Try
End Sub
' Remove bend lines subroutine
Sub RemoveBendLines(oView As DrawingView, oFlatPattern As FlatPattern)
Dim oBendEdgesUp As Edges =
oFlatPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge)
Dim oBendEdgesDown As Edges =
oFlatPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge)
For Each oEdge As Edge In oBendEdgesUp
For Each oCurve As DrawingCurve In oView.DrawingCurves(oEdge)
For Each oSegment As DrawingCurveSegment In oCurve.Segments
oSegment.Visible = False
Next
Next
Next
For Each oEdge As Edge In oBendEdgesDown
For Each oCurve As DrawingCurve In oView.DrawingCurves(oEdge)
For Each oSegment As DrawingCurveSegment In oCurve.Segments
oSegment.Visible = False
Next
Next
Next
End Sub
' Create TXT file subroutine
Sub CreateTXT(oText As String, oFileName As String)
Dim oTxtWriter As System.IO.StreamWriter =
System.IO.File.CreateText(oFileName)
oTxtWriter.WriteLine(oText)
oTxtWriter.Close()
End Sub