I have created an ilogic rule few weeks ago for an Italian forum.
I have just tested it a simple assembly and didn't have any feedback from OP.
Try it and let me know. There is some custom file name setting but it can be removed.
It was designed to distinguish between up and down bends as well:
Sub Main
Dim oAsmDoc As AssemblyDocument
If ThisApplication.ActiveDocument.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
MessageBox.Show("Esegui questa regola da un file di assieme.", "iLogic")
Exit Sub
End If
oAsmDoc = ThisApplication.ActiveDocument
Dim oAsmName As String = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) - 4)
Dim RUsure As MsgBoxResult
RUsure = MessageBox.Show(
"Questo crea un file DXF per tutti i componenti dell’assieme che sono in lamiera." & vbLf &
"Sei sicuro di voler creare i DXF di tutti i componenti dell’assieme?" & vbLf &
"Potrebbe volerci del tempo, sii paziente.",
"iLogic - Esportazione DXF in batch", MessageBoxButtons.YesNo)
If RUsure = vbNo Then Return
Dim oPath As String = ThisDoc.Path
Dim oFolder As String = oPath & "\" & oAsmName & " DXF Files"
If Not System.IO.Directory.Exists(oFolder) Then
System.IO.Directory.CreateDirectory(oFolder)
End If
Dim dxfCount As Integer = 0
Dim errReport As New List(Of String)
Dim oDoc As Document
Dim oPartDoc As PartDocument
Dim oFlatPart As PartDocument
Dim oCompDef As SheetMetalComponentDefinition
For Each occ As ComponentOccurrence In oAsmDoc.ComponentDefinition.Occurrences.AllLeafOccurrences
oDoc = occ.Definition.Document
If oDoc.DocumentType <> DocumentTypeEnum.kPartDocumentObject Then Continue For
oPartDoc = CType(oDoc, PartDocument)
If Not oPartDoc.ComponentDefinition.Type = ObjectTypeEnum.kSheetMetalComponentDefinitionObject Then Continue For
oFlatPart = ThisApplication.Documents.Open(oPartDoc.FullFileName, False)
oCompDef = oFlatPart.ComponentDefinition
' Elimina il flat pattern esistente, se presente
If oCompDef.HasFlatPattern Then
Try
oCompDef.FlatPattern.Delete()
Catch ex As Exception
errReport.Add(oPartDoc.DisplayName & " - Errore nell'eliminazione del flat pattern esistente.")
oFlatPart.Close(False)
Continue For
End Try
End If
' Crea un nuovo flat pattern
Try
oCompDef.Unfold()
oCompDef.FlatPattern.ExitEdit()
Catch ex As Exception
errReport.Add(oPartDoc.DisplayName & " - Errore nella creazione del flat pattern.")
oFlatPart.Close(False)
Continue For
End Try
' Rimuove eventuali schizzi vecchi
For Each sk In oCompDef.FlatPattern.Sketches
If sk.Name = "BendMarkers" Then sk.Delete()
Next
' Crea nuovo schizzo per marcatori piega
Dim oSketch As PlanarSketch = oCompDef.FlatPattern.Sketches.Add(oCompDef.FlatPattern.TopFace, False)
oSketch.Name = "BendMarkers"
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim segLength As Double = 0.2
Dim offset As Double = 0.5
Dim stubLength As Double = 0.2
' Piega verso l'alto
For Each oEdge As Edge In oCompDef.FlatPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge, True)
Try
Dim edgeGeom As LineSegment = TryCast(oEdge.Geometry, LineSegment)
If edgeGeom Is Nothing Then Continue For
Dim p1 As Point2d = oSketch.ModelToSketchSpace(edgeGeom.StartPoint)
Dim p2 As Point2d = oSketch.ModelToSketchSpace(edgeGeom.EndPoint)
Dim dx As Double = p2.X - p1.X
Dim dy As Double = p2.Y - p1.Y
Dim length As Double = Math.Sqrt(dx ^ 2 + dy ^ 2)
dx /= length
dy /= length
Dim off1 As Point2d = oTG.CreatePoint2d(p1.X + dx * offset, p1.Y + dy * offset)
Dim off2 As Point2d = oTG.CreatePoint2d(p2.X - dx * offset, p2.Y - dy * offset)
Dim pt1 As Point2d = oTG.CreatePoint2d(off1.X + dx * stubLength, off1.Y + dy * stubLength)
Dim pt2 As Point2d = oTG.CreatePoint2d(off2.X - dx * stubLength, off2.Y - dy * stubLength)
oSketch.SketchLines.AddByTwoPoints(off1, pt1)
oSketch.SketchLines.AddByTwoPoints(off2, pt2)
Catch
End Try
Next
' Piega verso il basso
For Each oEdge As Edge In oCompDef.FlatPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge, True)
Try
Dim edgeGeom As LineSegment = TryCast(oEdge.Geometry, LineSegment)
If edgeGeom Is Nothing Then Continue For
Dim p1 As Point2d = oSketch.ModelToSketchSpace(edgeGeom.StartPoint)
Dim p2 As Point2d = oSketch.ModelToSketchSpace(edgeGeom.EndPoint)
Dim dx As Double = p2.X - p1.X
Dim dy As Double = p2.Y - p1.Y
Dim length As Double = Math.Sqrt(dx ^ 2 + dy ^ 2)
dx /= length
dy /= length
Dim pt1 As Point2d = oTG.CreatePoint2d(p1.X + dx * stubLength, p1.Y + dy * stubLength)
Dim pt2 As Point2d = oTG.CreatePoint2d(p2.X - dx * stubLength, p2.Y - dy * stubLength)
oSketch.SketchLines.AddByTwoPoints(p1, pt1)
oSketch.SketchLines.AddByTwoPoints(p2, pt2)
Catch
End Try
Next
' Esporta il file DXF
Dim oFileName As String = oDoc.DisplayName
Dim oThickness As String = Round(oCompDef.Thickness.Value * 10, 1)
Dim CustomName As String
Try
CustomName = iProperties.Value(oFileName, "Custom", "PF_PRT_ZNR")
Catch
CustomName = "AST Srl -"
End Try
Dim fullFileName As String = oFolder & "\" & CustomName & " " & oFileName & " - " & oThickness & "mm.dxf"
Dim sOut As String
sOut = "FLAT PATTERN DXF?AcadVersion=2000" _
& "&InvisibleLayers=IV_TANGENT;IV_FEATURE_PROFILES;IV_ARC_CENTERS;IV_BEND;IV_BEND_DOWN;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_FEATURE_PROFILES_DOWN" _
& "&OuterProfileLayer=0" _
& "&InteriorProfilesLayer=0" _
& "&UnconsumedSketchesLayer=MARKERS" _
& "&UnconsumedSketchesLayerColor=255;0;0"
oCompDef.DataIO.WriteDataToFile(sOut, fullFileName)
dxfCount += 1
oCompDef.FlatPattern.ExitEdit()
oFlatPart.Close(True)
Next
' Messaggio finale di riepilogo
Dim summary As String = dxfCount & " file DXF generati."
If errReport.Count > 0 Then
summary &= vbLf & vbLf & "I seguenti componenti non sono stati processati correttamente:" & vbLf & String.Join(vbLf, errReport.ToArray())
End If
MessageBox.Show(summary, "iLogic - Riepilogo esportazione DXF")
End Sub
