Sub Main() ExecuteMainLogic() End Sub Sub ExecuteMainLogic() Dim oAsmDoc As AssemblyDocument = ThisDoc.Document Dim templateFile As String = GetTemplateFile(oAsmDoc) If templateFile = "" Then Exit Sub Dim oSketchCurves As Object() = Nothing Dim currentGroupIndex As Integer = 0 Dim highlightSets(3) As HighlightSet Do If oSketchCurves Is Nothing Then InitializeSketchCurvesAndHighlightSets(oSketchCurves, highlightSets, oAsmDoc) End If Dim selectionResult As String = SelectSketchCurvesForGroup(oSketchCurves, currentGroupIndex, highlightSets) Select Case selectionResult Case "Abort" ClearAllHighlightSets(highlightSets) Exit Sub Case "NextGroup" If DirectCast(oSketchCurves(currentGroupIndex), List(Of Object)).Count = 0 Then MessageBox.Show("You must select at least one curve in this group before proceeding.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Continue Do End If Dim mismatchMessage As String = CheckGroupMismatch(oSketchCurves, currentGroupIndex) If mismatchMessage <> "" Then MessageBox.Show(mismatchMessage, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) ' Bring up the main menu after showing the mismatch error Dim menuResult As String = PromptUserForOption(oSketchCurves, highlightSets) Select Case menuResult Case "Continue" Continue Do Case "PreviousGroup" MoveToPreviousGroup(currentGroupIndex, highlightSets) Case "Restart" ResetSelectionProcess(oSketchCurves, currentGroupIndex, highlightSets) Case "Abort" ClearAllHighlightSets(highlightSets) Exit Sub Case Else Continue Do End Select Continue Do End If If currentGroupIndex = 3 Then ' We're in the last group, check if all groups have at least one curve and match If AllGroupsHaveCurves(oSketchCurves) AndAlso CheckAllGroupsMatch(oSketchCurves) Then ' Prompt for panel generation Dim expectedPanelCount As Integer = DirectCast(oSketchCurves(0), List(Of Object)).Count * DirectCast(oSketchCurves(2), List(Of Object)).Count If MessageBox.Show("Reference geometry established successfully. Do you want to generate " & expectedPanelCount & " panels?", "Generate Panels?", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then Dim success As Boolean = ProcessAllGroups(oAsmDoc, templateFile, oSketchCurves, highlightSets) If success Then If MessageBox.Show("All " & expectedPanelCount & " panels were generated successfully. Do you want to add more?", "Add More Panels?", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2) = DialogResult.Yes Then ResetSelectionProcess(oSketchCurves, currentGroupIndex, highlightSets) Else Exit Sub End If Else ' Handle the case where panel generation failed MessageBox.Show("Panel generation failed. Please try again.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Continue Do End If Else ' User chose not to generate panels, open the main menu Dim menuResult As String = PromptUserForOption(oSketchCurves, highlightSets) Select Case menuResult Case "Continue" Continue Do Case "PreviousGroup" MoveToPreviousGroup(currentGroupIndex, highlightSets) Case "Restart" ResetSelectionProcess(oSketchCurves, currentGroupIndex, highlightSets) Case "Abort" ClearAllHighlightSets(highlightSets) Exit Sub Case Else ' Handle other cases as needed Continue Do End Select End If Else MessageBox.Show("You must select at least one curve in each group and ensure the number of curves match between corresponding groups.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) ' Bring up the main menu after showing the error Dim menuResult As String = PromptUserForOption(oSketchCurves, highlightSets) Select Case menuResult Case "Continue" Continue Do Case "PreviousGroup" MoveToPreviousGroup(currentGroupIndex, highlightSets) Case "Restart" ResetSelectionProcess(oSketchCurves, currentGroupIndex, highlightSets) Case "Abort" ClearAllHighlightSets(highlightSets) Exit Sub Case Else Continue Do End Select Continue Do End If Else MoveToNextGroup(currentGroupIndex, highlightSets) End If Case "PreviousGroup" MoveToPreviousGroup(currentGroupIndex, highlightSets) Case "Restart" ResetSelectionProcess(oSketchCurves, currentGroupIndex, highlightSets) Case "Continue" ' Just continue the loop Case "Error", "NoEdgesSelected" ' Handle these cases as needed, possibly by showing an appropriate message Continue Do Case "Success" ' This case is now handled in the "NextGroup" section currentGroupIndex += 1 End Select If currentGroupIndex = 4 Then ' This case is now handled in the "NextGroup" section above currentGroupIndex = 3 ' Keep it at the last group Continue Do End If Loop End Sub Sub InitializeSketchCurvesAndHighlightSets(ByRef oSketchCurves As Object(), ByRef highlightSets() As HighlightSet, oAsmDoc As AssemblyDocument) oSketchCurves = New Object(3) {} For i As Integer = 0 To 3 oSketchCurves(i) = New List(Of Object) highlightSets(i) = CreateColoredHighlightSet(oAsmDoc, GetGroupColor(i)) Next End Sub Sub ClearAllHighlightSets(highlightSets() As HighlightSet) For Each HighlightSet In highlightSets If HighlightSet IsNot Nothing Then HighlightSet.Clear() Next ThisApplication.ActiveView.Update() End Sub Sub ResetSelectionProcess(ByRef oSketchCurves As Object(), ByRef currentGroupIndex As Integer, highlightSets() As HighlightSet) ClearAllHighlightSets(highlightSets) oSketchCurves = Nothing currentGroupIndex = 0 End Sub Sub MoveToPreviousGroup(ByRef currentGroupIndex As Integer, highlightSets() As HighlightSet) If currentGroupIndex > 0 Then ClearHighlightSet(highlightSets(currentGroupIndex)) currentGroupIndex -= 1 Else MessageBox.Show("Already at the first group.", "Information") End If End Sub Sub MoveToNextGroup(ByRef currentGroupIndex As Integer, highlightSets() As HighlightSet) If currentGroupIndex < 3 Then currentGroupIndex += 1 Else MessageBox.Show("Already at the last group.", "Information") End If End Sub Sub ToggleCurveSelection(groupCurves As List(Of Object), curve As Object, highlightSet As HighlightSet) Dim index As Integer = groupCurves.IndexOf(curve) If index <> -1 Then groupCurves.RemoveAt(index) RemoveHighlight(highlightSet, curve) Else groupCurves.Add(curve) highlightSet.AddItem(curve) End If End Sub Sub ClearHighlightSet(HighlightSet As HighlightSet) If HighlightSet IsNot Nothing Then HighlightSet.Clear() ThisApplication.ActiveView.Update() End Sub Sub RemoveHighlight(HighlightSet As HighlightSet, item As Object) On Error Resume Next HighlightSet.Remove(item) If Err.Number <> 0 Then MessageBox.Show("Unable to remove highlight. Error: " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End If On Error GoTo 0 End Sub Sub ContinueWithNewTemplate(ByRef oSketchCurves As Object(), ByRef highlightSets() As HighlightSet) ' Store the current selection Dim tempSketchCurves As Object() = oSketchCurves.Clone() ' Clear current highlight sets ClearAllHighlightSets(highlightSets) ' Reinitialize with new template InitializeSketchCurvesAndHighlightSets(oSketchCurves, highlightSets, ThisDoc.Document) ' Restore the selection and highlight states For i As Integer = 0 To 3 oSketchCurves(i) = tempSketchCurves(i) Dim groupCurves As List(Of Object) = DirectCast(oSketchCurves(i), List(Of Object)) For Each curve In groupCurves highlightSets(i).AddItem(curve) Next Next ' Update the view to show the restored highlights ThisApplication.ActiveView.Update() End Sub Sub CreateAndConstrainOccurrence(oAsmDoc As AssemblyDocument, templateFile As String, oPlane As Object, bottomCurve As Object, topCurve As Object, leftCurve As Object, rightCurve As Object, i As Integer, j As Integer) Dim newCopyFile As String = CreateCopyOfTemplate(templateFile) Dim oOccurrence As ComponentOccurrence = AddOccurrenceToAssembly(oAsmDoc, newCopyFile) If oOccurrence Is Nothing Then MessageBox.Show("Failed to add occurrence for bottom curve " & (i + 1) & " and left curve " & (j + 1) & ".", "Error") Exit Sub End If oOccurrence.Adaptive = True Dim oOccPlaneFront As WorkPlane = GetOccurrencePlane(oOccurrence, "PlaneFront") If oOccPlaneFront IsNot Nothing Then CreateFlushConstraint(oAsmDoc, oPlane, oOccurrence, oOccPlaneFront) End If CreateMateConstraint(oAsmDoc, bottomCurve, oOccurrence, "AxisBottom") CreateMateConstraint(oAsmDoc, topCurve, oOccurrence, "AxisTop") CreateMateConstraint(oAsmDoc, leftCurve, oOccurrence, "AxisLeft") CreateMateConstraint(oAsmDoc, rightCurve, oOccurrence, "AxisRight") End Sub Sub CreateFlushConstraint(oAsmDoc As AssemblyDocument, oPlane As Object, oOccurrence As ComponentOccurrence, oOccPlane As WorkPlane) Dim oOccPlaneProxy As WorkPlaneProxy oOccurrence.CreateGeometryProxy(oOccPlane, oOccPlaneProxy) Dim oFlushConstraint As FlushConstraint oFlushConstraint = oAsmDoc.ComponentDefinition.Constraints.AddFlushConstraint(oPlane, oOccPlaneProxy, 0) End Sub Sub CreateMateConstraint(oAsmDoc As AssemblyDocument, curve As Object, oOccurrence As ComponentOccurrence, axisName As String) Dim oOccAxis As WorkAxis = oOccurrence.Definition.WorkAxes.Item(axisName) Dim oOccAxisProxy As WorkAxisProxy oOccurrence.CreateGeometryProxy(oOccAxis, oOccAxisProxy) oAsmDoc.ComponentDefinition.Constraints.AddMateConstraint(curve, oOccAxisProxy, 0) End Sub Sub SetDocumentParameter(doc As Document, paramName As String, value As String) Dim param As Parameter = Nothing On Error Resume Next param = doc.ComponentDefinition.Parameters.UserParameters.Item(paramName) On Error GoTo 0 If param Is Nothing Then doc.ComponentDefinition.Parameters.UserParameters.AddByValue(paramName, value, UnitsTypeEnum.kTextUnits) Else param.Expression = """" & value & """" End If End Sub Sub CreateAdaptiveOccurrences(oAsmDoc As AssemblyDocument, templateFile As String, oPlane As Object, oSketchCurves() As Object) Dim bottomCurves As List(Of Object) = DirectCast(oSketchCurves(0), List(Of Object)) Dim topCurves As List(Of Object) = DirectCast(oSketchCurves(1), List(Of Object)) Dim leftCurves As List(Of Object) = DirectCast(oSketchCurves(2), List(Of Object)) Dim rightCurves As List(Of Object) = DirectCast(oSketchCurves(3), List(Of Object)) If Not ValidateCurveCounts(bottomCurves, topCurves, leftCurves, rightCurves) Then Exit Sub For i As Integer = 0 To bottomCurves.Count - 1 For j As Integer = 0 To leftCurves.Count - 1 CreateAndConstrainOccurrence(oAsmDoc, templateFile, oPlane, bottomCurves(i), topCurves(i), leftCurves(j), rightCurves(j), i, j) Next Next End Sub Function GetTemplateFile(oAsmDoc As AssemblyDocument) As String Dim paramName As String = "LastUsedTemplatePath" Dim lastUsedPath As String = GetDocumentParameter(oAsmDoc, paramName) If lastUsedPath <> "" AndAlso System.IO.File.Exists(lastUsedPath) Then Dim result As DialogResult = MessageBox.Show("Do you want to use the same template as last time?" & vbNewLine & "Path: " & lastUsedPath, "Use Previous Template?", MessageBoxButtons.YesNoCancel) If result = DialogResult.Yes Then Return lastUsedPath ElseIf result = DialogResult.Cancel Then Return "" End If End If Dim selectedFile As String = SelectFile() If selectedFile <> "" Then SetDocumentParameter(oAsmDoc, paramName, selectedFile) Return selectedFile End If Return lastUsedPath ' Return the last used path if no new file was selected End Function Function SelectFile() As String Dim oFileDlg As Inventor.FileDialog = Nothing ThisApplication.CreateFileDialog(oFileDlg) oFileDlg.InitialDirectory = "C:\" oFileDlg.Filter = "Inventor Files (*.ipt; *.iam)|*.ipt; *.iam|All Files (*.*)|*.*" oFileDlg.DialogTitle = "Select a template file" oFileDlg.CancelError = True On Error Resume Next oFileDlg.ShowOpen() If Err.Number <> 0 Then MessageBox.Show("File selection canceled.", "Error") Return "" ElseIf oFileDlg.FileName = "" Then MessageBox.Show("No file selected.", "Error") Return "" End If On Error GoTo 0 Return oFileDlg.FileName End Function Function SelectSketchCurvesForGroup(ByRef oSketchCurves As Object(), groupIndex As Integer, highlightSets() As HighlightSet) As String Dim curveGroups As String() = {"Bottom", "Top", "Left", "Right"} Dim groupCurves As List(Of Object) = DirectCast(oSketchCurves(groupIndex), List(Of Object)) Dim firstCurveSketch As Sketch = If(groupCurves.Count > 0, groupCurves(0).Parent, Nothing) ThisApplication.StatusBarText = "Select edges for the " & curveGroups(groupIndex) & " group. Press Esc when done." Try While True Dim curve As Object = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kSketchCurveFilter, "Select edges for the " & curveGroups(groupIndex) & " group (Esc when done)") If curve Is Nothing Then If groupCurves.Count > 0 Then ' User pressed Esc after selecting at least one curve System.Windows.Forms.Application.DoEvents() System.Threading.Thread.Sleep(200) System.Windows.Forms.Application.DoEvents() Return "NextGroup" Else ' No curves selected, open the menu Dim result As String = PromptUserForOption(oSketchCurves, highlightSets) If result = "Abort" Then If MessageBox.Show("Are you sure you want to abort operation?", "Confirm Abort", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then Return "Abort" Else Continue While End If ElseIf result <> "Continue" Then Return result End If End If Else If firstCurveSketch Is Nothing Then firstCurveSketch = curve.Parent End If If curve.Parent Is firstCurveSketch Then ' Check if the curve is already used in a previous group Dim isUsed As Boolean = False For i As Integer = 0 To groupIndex - 1 If DirectCast(oSketchCurves(i), List(Of Object)).Contains(curve) Then isUsed = True Exit For End If Next If Not isUsed Then ToggleCurveSelection(groupCurves, curve, highlightSets(groupIndex)) End If End If ThisApplication.ActiveView.Update() End If End While Catch ex As Exception Return "Error" End Try If groupCurves.Count = 0 Then Return "NoCurvesSelected" End If Return "Success" End Function Function GetGroupColor(groupIndex As Integer) As Inventor.Color Select Case groupIndex Case 0 ' Bottom Return ThisApplication.TransientObjects.CreateColor(0, 0, 255) ' Blue Case 1 ' Top Return ThisApplication.TransientObjects.CreateColor(255, 255, 0) ' Yellow Case 2 ' Left Return ThisApplication.TransientObjects.CreateColor(255, 0, 0) ' Red Case 3 ' Right Return ThisApplication.TransientObjects.CreateColor(0, 255, 0) ' Green Case Else Return ThisApplication.TransientObjects.CreateColor(255, 255, 255) ' White End Select End Function Function PromptUserForOption(ByRef oSketchCurves As Object(), ByRef highlightSets() As HighlightSet) As String Dim options As String() = { "Continue", "Back", "Restart", "Change Template" } Dim selectedOption As String = InputListBox("Select an option:", options, options(0), "Main Menu") Select Case selectedOption Case "Continue" Return "Continue" Case "Back" Return "PreviousGroup" Case "Restart" Return "Restart" Case "Change Template" Dim newTemplate As String = SelectFile() If newTemplate <> "" Then SetDocumentParameter(ThisDoc.Document, "LastUsedTemplatePath", newTemplate) ContinueWithNewTemplate(oSketchCurves, highlightSets) Return "Continue" Else Return PromptUserForOption(oSketchCurves, highlightSets) End If Case Else Return "Abort" End Select End Function Function GetOccurrencePlane(oOccurrence As ComponentOccurrence, planeName As String) As WorkPlane Dim oOccPlane As WorkPlane On Error Resume Next oOccPlane = oOccurrence.Definition.WorkPlanes.Item(planeName) On Error GoTo 0 If oOccPlane Is Nothing Then MessageBox.Show("Geometric entity '" & planeName & "' cannot be found. Aborting operation.", "Error") End If Return oOccPlane End Function Function CheckMatchingCounts(groupIndex As Integer, groupCurves As List(Of Object), oSketchCurves() As Object) As Boolean Dim curveGroups As String() = {"Bottom", "Top", "Left", "Right"} If (groupIndex = 1 AndAlso groupCurves.Count <> oSketchCurves(0).Count) OrElse _ (groupIndex = 3 AndAlso groupCurves.Count <> oSketchCurves(2).Count) Then Dim message As String = "The number of " & curveGroups(groupIndex) & " curves doesn't match the number of " & _ IIf(groupIndex = 1, "Bottom", "Left") & " curves. An error occurred because the numbers don't match." MessageBox.Show(message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Return False End If Return True End Function Function ValidateCurveCounts(bottomCurves As List(Of Object), topCurves As List(Of Object), leftCurves As List(Of Object), rightCurves As List(Of Object)) As Boolean If bottomCurves.Count <> topCurves.Count Then MessageBox.Show("The number of bottom and top curves must be the same.", "Error") Return False End If If leftCurves.Count <> rightCurves.Count Then MessageBox.Show("The number of left and right curves must be the same.", "Error") Return False End If Return True End Function Function CreateCopyOfTemplate(originalFile As String) As String Dim fso As Object = CreateObject("Scripting.FileSystemObject") Dim folder As String = fso.GetParentFolderName(originalFile) Dim baseName As String = fso.GetBaseName(originalFile) Dim extension As String = fso.GetExtensionName(originalFile) Dim newFile As String Dim randomSuffix As String Do randomSuffix = GenerateRandomSuffix(8) newFile = folder & "\" & baseName & "-" & randomSuffix & "." & extension Loop While fso.FileExists(newFile) fso.CopyFile(originalFile, newFile) If fso.FileExists(newFile) Then Return newFile Else Return "" End If End Function Function GenerateRandomSuffix(length As Integer) As String Dim chars As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" Dim random As New Random() Dim result As String = "" For i As Integer = 1 To length result &= Chars(random.Next(0, chars.Length)) Next Return result End Function Function AddOccurrenceToAssembly(oAsmDoc As AssemblyDocument, filePath As String) As ComponentOccurrence Dim oOccurrence As ComponentOccurrence oOccurrence = oAsmDoc.ComponentDefinition.Occurrences.Add(filePath, ThisApplication.TransientGeometry.CreateMatrix()) If oOccurrence Is Nothing Then MessageBox.Show("Failed to add the selected file as an occurrence.", "Error") End If Return oOccurrence End Function Function GetDocumentParameter(doc As Document, paramName As String) As String Dim param As Parameter = Nothing On Error Resume Next param = doc.ComponentDefinition.Parameters.UserParameters.Item(paramName) On Error GoTo 0 If param IsNot Nothing Then Return CStr(param.Value) Else Return "" End If End Function Function CheckGroupMismatch(oSketchCurves As Object(), currentGroupIndex As Integer) As String If currentGroupIndex = 1 OrElse currentGroupIndex = 3 Then Dim previousGroup As Integer = If(currentGroupIndex = 1, 0, 2) Dim currentCount As Integer = DirectCast(oSketchCurves(currentGroupIndex), List(Of Object)).Count Dim previousCount As Integer = DirectCast(oSketchCurves(previousGroup), List(Of Object)).Count If currentCount <> previousCount Then Dim difference As Integer = Math.Abs(currentCount - previousCount) If currentCount > previousCount Then Return "The amount of edges in this group does not match the previous group. You need to deselect " & difference & " edge(s)." Else Return "The amount of edges in this group does not match the previous group. You need to select " & difference & " more edge(s)." End If End If End If Return "" End Function Function CheckAllGroupsMatch(oSketchCurves As Object()) As Boolean Return DirectCast(oSketchCurves(0), List(Of Object)).Count = DirectCast(oSketchCurves(1), List(Of Object)).Count AndAlso DirectCast(oSketchCurves(2), List(Of Object)).Count = DirectCast(oSketchCurves(3), List(Of Object)).Count End Function Function AllGroupsHaveCurves(oSketchCurves As Object()) As Boolean For i As Integer = 0 To 3 If DirectCast(oSketchCurves(i), List(Of Object)).Count = 0 Then Return False End If Next Return True End Function Function GetSketchPlane(firstCurve As Object) As Object Dim sketch As Sketch = firstCurve.Parent Return sketch.PlanarEntity End Function Function CreateColoredHighlightSet(doc As Document, Color As Inventor.Color) As HighlightSet Dim HighlightSet As HighlightSet = doc.CreateHighlightSet HighlightSet.Color = Color Return HighlightSet End Function Function ProcessAllGroups(oAsmDoc As AssemblyDocument, templateFile As String, oSketchCurves() As Object, highlightSets() As HighlightSet) As Boolean Dim oPlane As Object = GetSketchPlane(oSketchCurves(0)(0)) If oPlane Is Nothing Then ClearAllHighlightSets(highlightSets) Return False End If CreateAdaptiveOccurrences(oAsmDoc, templateFile, oPlane, oSketchCurves) ClearAllHighlightSets(highlightSets) Return True End Function