AddReference "System.Drawing" Imports Inventor Imports System.Windows.Forms Imports System.Globalization Imports System.Text Imports System.Collections.Generic ' Flat Pattern Calculator — external iLogic rule ' Target: Autodesk Inventor 2026, sheet-metal Part (.ipt) ' IMPORTANT: Validate all reported values and DXF output on representative test parts. Dim doc As Document = ThisDoc.Document If doc.DocumentType <> DocumentTypeEnum.kPartDocumentObject Then MessageBox.Show("This document is not a Part!", "Flat Pattern Calculator", MessageBoxButtons.OK, MessageBoxIcon.Error) Return End If Dim partDoc As PartDocument = CType(doc, PartDocument) Dim smDef As SheetMetalComponentDefinition Try smDef = CType(partDoc.ComponentDefinition, SheetMetalComponentDefinition) Catch MessageBox.Show("This file is not a Sheet Metal part!", "Flat Pattern Calculator", MessageBoxButtons.OK, MessageBoxIcon.Error) Return End Try ' A new DXF file needs a saved source document so its output path is known. If String.IsNullOrWhiteSpace(doc.FullFileName) Then MessageBox.Show("Save the part before running the rule.", "Flat Pattern Calculator", MessageBoxButtons.OK, MessageBoxIcon.Warning) Return End If ' Inventor API database length units are centimetres; angles are radians; mass is kg. Dim mmPerCm As Double = 10.0 Dim cm2PerM2 As Double = 10000.0 Dim cmPerM As Double = 100.0 If Not smDef.HasFlatPattern Then Try smDef.Unfold() smDef.FlatPattern.ExitEdit() Catch ex As Exception MessageBox.Show("Failed to create Flat Pattern:" & vbCrLf & ex.Message, "Flat Pattern Calculator", MessageBoxButtons.OK, MessageBoxIcon.Error) Return End Try End If Dim flat As FlatPattern = smDef.FlatPattern Dim topFace As Face = flat.TopFace Dim invApp As Inventor.Application = ThisApplication Dim measureTools As MeasureTools = invApp.MeasureTools Dim uom As UnitsOfMeasure = doc.UnitsOfMeasure ' Formatting helpers: use invariant decimal separators for stable report/property values. Dim Fmt = Function(value As Double, pattern As String) As String Return value.ToString(pattern, CultureInfo.InvariantCulture) End Function Dim EscapeRtf = Function(value As String) As String If value Is Nothing Then Return "" Dim result As New StringBuilder() For Each ch As Char In value Select Case ch Case "\"c : result.Append("\\") Case "{"c : result.Append("\{") Case "}"c : result.Append("\}") Case ControlChars.Cr : ' Ignore carriage returns Case ControlChars.Lf : result.Append("\line ") Case Else If AscW(ch) < 0 OrElse AscW(ch) > 127 Then result.Append("\u" & CInt(AscW(ch)).ToString(CultureInfo.InvariantCulture) & "?") Else result.Append(ch) End If End Select Next Return result.ToString() End Function Dim RtfHeader As String = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033" & "{\fonttbl{\f0\fnil\fcharset0 Consolas;}}" & "{\colortbl ;\red0\green120\blue0;\red0\green70\blue180;\red200\green0\blue0;\red100\green100\blue100;}" ' Document metadata Dim fileName As String = System.IO.Path.GetFileName(doc.FullFileName) Dim creationDate As String = "Unknown" Try Dim dateValue As Object = doc.PropertySets.Item("Design Tracking Properties").Item("Creation Time").Value If dateValue IsNot Nothing Then creationDate = Convert.ToDateTime(dateValue).ToString("yyyy-MM-dd", CultureInfo.InvariantCulture) Catch End Try Dim materialName As String = "Unknown" Try materialName = smDef.Material.Name Catch End Try ' Explicitly convert API database units (cm) to mm. Dim flatLength As Double = Math.Round(flat.Length * mmPerCm, 1) Dim flatWidth As Double = Math.Round(flat.Width * mmPerCm, 1) Dim thicknessMm As Double = Math.Round(smDef.Thickness.Value * mmPerCm, 2) Dim dimensionsText As String = Fmt(flatLength, "0.0") & " x " & Fmt(flatWidth, "0.0") & " x " & Fmt(thicknessMm, "0.00") Dim massKg As Double = 0 Try massKg = Math.Round(partDoc.ComponentDefinition.MassProperties.Mass, 3) Catch End Try ' Площа прямокутника габаритів розгортки Dim areaM2 As Double = Math.Round((flat.Length * flat.Width) / 10000.0, 4) Dim totalCutLengthCm As Double = 0 Dim outerCutLengthCm As Double = 0 For Each edgeLoop As EdgeLoop In topFace.EdgeLoops Dim loopLength As Double = measureTools.GetLoopLength(edgeLoop) totalCutLengthCm += loopLength If edgeLoop.IsOuterEdgeLoop Then outerCutLengthCm += loopLength Next Dim totalCutLengthM As Double = Math.Round(totalCutLengthCm / cmPerM, 2) Dim outerCutLengthM As Double = Math.Round(outerCutLengthCm / cmPerM, 2) ' Count inner loops and group approximate contour sizes. ' Note: bounding-box dimensions based on edge vertices can underestimate arcs/slots. Dim innerLoopsCount As Integer = 0 Dim groupedHoles As New Dictionary(Of String, Dictionary(Of String, Integer))(StringComparer.Ordinal) For Each edgeLoop As EdgeLoop In topFace.EdgeLoops If Not edgeLoop.IsOuterEdgeLoop Then innerLoopsCount += 1 Dim isCircular As Boolean = True Dim circleRadiusMm As Double = 0 Dim lineCount As Integer = 0 Dim arcCount As Integer = 0 Dim minX As Double = Double.MaxValue Dim minY As Double = Double.MaxValue Dim maxX As Double = Double.MinValue Dim maxY As Double = Double.MinValue For Each edge As Edge In edgeLoop.Edges If edge.GeometryType = CurveTypeEnum.kCircleCurve OrElse edge.GeometryType = CurveTypeEnum.kCircularArcCurve Then arcCount += 1 Try Dim curve As Object = edge.Geometry circleRadiusMm = CDbl(CallByName(curve, "Radius", CallType.Get)) * mmPerCm Catch End Try ElseIf edge.GeometryType = CurveTypeEnum.kLineSegmentCurve Then lineCount += 1 isCircular = False Else isCircular = False End If Dim points As Inventor.Point() = {edge.StartVertex.Point, edge.StopVertex.Point} For Each pt As Inventor.Point In points Dim xMm As Double = pt.X * mmPerCm Dim yMm As Double = pt.Y * mmPerCm minX = Math.Min(minX, xMm) minY = Math.Min(minY, yMm) maxX = Math.Max(maxX, xMm) maxY = Math.Max(maxY, yMm) Next Next Dim widthMm As Double = Math.Round(Math.Max(0, maxX - minX), 1) Dim heightMm As Double = Math.Round(Math.Max(0, maxY - minY), 1) Dim holeType As String = "Other" Dim sizeName As String = Fmt(widthMm, "0.0") & " x " & Fmt(heightMm, "0.0") & " mm" If isCircular AndAlso arcCount > 0 Then holeType = "Round" sizeName = "D" & Fmt(Math.Round(circleRadiusMm * 2, 1), "0.0") & " mm" ElseIf lineCount = 2 AndAlso arcCount = 2 Then holeType = "Obround (Slot)" Dim dim1 As Double = Math.Min(widthMm, heightMm) Dim dim2 As Double = Math.Max(widthMm, heightMm) sizeName = Fmt(dim1, "0.0") & " x " & Fmt(dim2, "0.0") & " mm" ElseIf lineCount = 4 AndAlso arcCount = 0 Then If Math.Abs(widthMm - heightMm) < 0.1 Then holeType = "Square" Else holeType = "Rectangular" End If End If If Not groupedHoles.ContainsKey(holeType) Then groupedHoles.Add(holeType, New Dictionary(Of String, Integer)(StringComparer.Ordinal)) End If If Not groupedHoles(holeType).ContainsKey(sizeName) Then groupedHoles(holeType).Add(sizeName, 1) Else groupedHoles(holeType)(sizeName) += 1 End If End If Next Dim holesRtf As New StringBuilder() If innerLoopsCount = 0 Then holesRtf.Append(" None") Else For Each typeEntry As KeyValuePair(Of String, Dictionary(Of String, Integer)) In groupedHoles holesRtf.Append(" \bullet \b " & EscapeRtf(typeEntry.Key) & ":\b0\line ") For Each sizeEntry As KeyValuePair(Of String, Integer) In typeEntry.Value holesRtf.Append(" - " & EscapeRtf(sizeEntry.Key) & " -> \b " & sizeEntry.Value.ToString(CultureInfo.InvariantCulture) & "\b0 pcs.\line ") Next Next End If ' K-factor is exposed by FlatBendResult; do not treat Unfold_Method_Value as a K-factor. Dim kFactor As Double = Double.NaN Dim bendRadiusMm As Double = Double.NaN Try For Each bendResult As FlatBendResult In flat.FlatBendResults If Not bendResult.IsOnBottomFace Then kFactor = bendResult.KFactor bendRadiusMm = bendResult.InnerRadius * mmPerCm Exit For End If Next Catch End Try If Double.IsNaN(bendRadiusMm) Then Try bendRadiusMm = smDef.BendRadius.Value * mmPerCm Catch bendRadiusMm = thicknessMm End Try End If Dim bendsInfo As New List(Of String) Dim bendIndex As Integer = 1 For Each bendResult As FlatBendResult In flat.FlatBendResults ' Inventor returns a top-face and bottom-face result for each physical bend. If Not bendResult.IsOnBottomFace Then Dim directionText As String = "\cf1 Up\cf0" If Not bendResult.IsDirectionUp Then directionText = "\cf3 Down\cf0" Dim angleDeg As Double = Math.Round(bendResult.Angle * (180.0 / Math.PI), 1) bendsInfo.Add(" \bullet \b Bend #" & bendIndex.ToString(CultureInfo.InvariantCulture) & ":\b0 " & Fmt(angleDeg, "0.0") & "° (" & directionText & ")") bendIndex += 1 End If Next Dim bendsCount As Integer = bendsInfo.Count Dim bendsRtf As String = If(bendsCount = 0, " None", String.Join("\line ", bendsInfo)) ' Write custom iProperties with stable invariant formatting. Try iProperties.Value("Custom", "Area_m2") = Fmt(areaM2, "0.0000") & " m2" iProperties.Value("Custom", "Total_Cut_m") = Fmt(totalCutLengthM, "0.00") & " m" iProperties.Value("Custom", "Outer_Cut_m") = Fmt(outerCutLengthM, "0.00") & " m" iProperties.Value("Custom", "Holes_Count") = innerLoopsCount iProperties.Value("Custom", "Bends_Count") = bendsCount Catch ex As Exception MessageBox.Show("The report was calculated, but one or more custom iProperties could not be written:" & vbCrLf & ex.Message, "iProperties Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning) End Try Dim sb As New StringBuilder() sb.Append(RtfHeader) sb.Append("\f0\fs21 ") sb.Append("\cf2\b File Name:\b0\cf0 " & EscapeRtf(fileName) & "\line ") sb.Append("\cf2\b Creation Date:\b0\cf0 " & EscapeRtf(creationDate) & "\line ") sb.Append("\cf2\b Material:\b0\cf0 " & EscapeRtf(materialName) & "\line\line ") sb.Append("\cf2\b Flat Extents:\b0\cf0 \b " & EscapeRtf(dimensionsText) & " mm\b0\line ") sb.Append("\cf2\b Mass:\b0\cf0 " & Fmt(massKg, "0.000") & " kg\line ") sb.Append("\cf2\b Flat Pattern Area:\b0\cf0 " & Fmt(areaM2, "0.0000") & " m2\line ") sb.Append("\cf2\b Total Cut Length:\b0\cf0 " & Fmt(totalCutLengthM, "0.00") & " m\line ") sb.Append("\cf2\b Outer Contour Cut:\b0\cf0 " & Fmt(outerCutLengthM, "0.00") & " m\line\line ") sb.Append("\cf2\b Total Inner Loops:\b0\cf0 " & innerLoopsCount.ToString(CultureInfo.InvariantCulture) & " pcs.\line ") sb.Append("\cf2\b Inner Loops List (grouped by type and size):\b0\cf0\line " & holesRtf.ToString() & "\line\line ") If Double.IsNaN(kFactor) Then sb.Append("\cf4\i Bend Radius = " & Fmt(bendRadiusMm, "0.00") & " mm; K-Factor = unavailable\i0\line\line ") Else sb.Append("\cf4\i Bend Radius = " & Fmt(bendRadiusMm, "0.00") & " mm; K-Factor = " & Fmt(kFactor, "0.000") & "\i0\line\line ") End If sb.Append("\cf2\b Total Bends:\b0\cf0 " & bendsCount.ToString(CultureInfo.InvariantCulture) & " pcs.\line ") sb.Append("\cf2\b Bends List:\b0\cf0\line " & bendsRtf) sb.Append("}") ' --- User interface --- Dim reportForm As New Form() reportForm.Text = "Flat Pattern Calculator" reportForm.Size = New System.Drawing.Size(700, 700) reportForm.FormBorderStyle = FormBorderStyle.FixedDialog reportForm.StartPosition = FormStartPosition.CenterScreen reportForm.MaximizeBox = False reportForm.MinimizeBox = False Dim rtfBox As New RichTextBox() rtfBox.ReadOnly = True rtfBox.ScrollBars = RichTextBoxScrollBars.Vertical rtfBox.Rtf = sb.ToString() rtfBox.Location = New System.Drawing.Point(20, 20) rtfBox.Size = New System.Drawing.Size(645, 550) reportForm.Controls.Add(rtfBox) Dim btnCopy As New Button() btnCopy.Text = "Copy Report to Clipboard" btnCopy.Location = New System.Drawing.Point(20, 590) btnCopy.Size = New System.Drawing.Size(205, 42) AddHandler btnCopy.Click, Sub(sender As Object, args As EventArgs) Try ' Copy formatted report (RTF) as well as readable plain text. Clipboard.SetText(rtfBox.Text) MessageBox.Show("Report text copied to clipboard.", "Success", MessageBoxButtons.OK, MessageBoxIcon.Information) Catch ex As Exception MessageBox.Show("Could not copy report: " & ex.Message, "Clipboard Error", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub reportForm.Controls.Add(btnCopy) Dim btnDxf As New Button() btnDxf.Text = "Export to DXF (2004)" btnDxf.Location = New System.Drawing.Point(240, 590) btnDxf.Size = New System.Drawing.Size(205, 42) btnDxf.Font = New System.Drawing.Font("Segoe UI", 9, System.Drawing.FontStyle.Bold) btnDxf.BackColor = System.Drawing.Color.LightGreen AddHandler btnDxf.Click, Sub(sender As Object, args As EventArgs) Try Dim partPath As String = System.IO.Path.GetDirectoryName(doc.FullFileName) Dim rawName As String = System.IO.Path.GetFileNameWithoutExtension(doc.FullFileName) Dim safeThick As String = Fmt(thicknessMm, "0.00").Replace(".", "_") Dim safeLength As String = Fmt(flatLength, "0.0").Replace(".", "_") Dim safeWidth As String = Fmt(flatWidth, "0.0").Replace(".", "_") Dim dxfFileName As String = rawName & "_" & safeThick & "mm_" & safeLength & "x" & safeWidth & ".dxf" Dim fullDxfPath As String = System.IO.Path.Combine(partPath, dxfFileName) If System.IO.File.Exists(fullDxfPath) Then Dim answer As DialogResult = MessageBox.Show( "The following file already exists:" & vbCrLf & dxfFileName & vbCrLf & vbCrLf & "Overwrite it?", "Confirm Overwrite", MessageBoxButtons.YesNo, MessageBoxIcon.Warning) If answer <> DialogResult.Yes Then Return End If ' OuterProfileJustification is not a documented DataIO option; omit the invalid value. Dim dxfOptions As String = "FLAT PATTERN DXF?AcadVersion=2004" & "&InvisibleLayers=IV_TANGENT;IV_BEND;IV_BEND_DOWN;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN" & "&SimplifySplines=True" & "&MergeProfilesIntoPolyline=True" flat.DataIO.WriteDataToFile(dxfOptions, fullDxfPath) If System.IO.File.Exists(fullDxfPath) Then MessageBox.Show("DXF exported successfully:" & vbCrLf & fullDxfPath, "Export Completed", MessageBoxButtons.OK, MessageBoxIcon.Information) Else MessageBox.Show("Inventor did not create the expected DXF file.", "Export Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning) End If Catch ex As Exception MessageBox.Show("Error exporting DXF:" & vbCrLf & ex.Message, "Export Error", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub reportForm.Controls.Add(btnDxf) Dim btnClose As New Button() btnClose.Text = "Close" btnClose.Location = New System.Drawing.Point(485, 590) btnClose.Size = New System.Drawing.Size(180, 42) AddHandler btnClose.Click, Sub(sender As Object, args As EventArgs) reportForm.Close() End Sub reportForm.Controls.Add(btnClose) reportForm.ShowDialog()