Community
If someone is able to help me solve this problem, it would really make me look good to my boss...
I don't love the way iCopy works, so I've been trying to build my own iLogic tool for rapidly assembling a wall of aluminum panels. The basic idea is that you still start with an adaptive template, select geometry to constrain to, and generate multiple parts. in the example below, I've selected all my bottom, top, left, and right edges with different colors. it detects how many panels to build based on the geometry and generates.
If you press escape without selecting any geometry for the current group, it prompts you to choose an option from the main menu:
The code isn't pretty, but it works as intended. My problem is that you can only single click curves one at a time. I want to give the user the option to window select curves to speed up the process. the idea is that they would pick all the bottom edges, proceed to the next step, then window select all the horizontal lines. the code has functions in place that do not allow you to pick a curve that has been reserved for a previous group, so in theory it should work.
I've tried implementing code like the example below into my selection process, but it always causes more issues than it solves:
Sub Main
'create the selectionclass
Dim oSelection As New clsSelect
'call the window select sub in the class
oSelection.WindowSelect(ThisApplication)
'exit sub if getting the count creates an error ( user escaped with nothing selected)
Try : iCount = oSelection.SelectedObjects.Count : Catch : Exit Sub : End Try
MsgBox(iCount & " sketch curve(s) selected.", , "iLogic")
'You can add your custom logic here to work with the selected sketch curves
'For example:
'For Each oSketchCurve As SketchEntity In oSelection.SelectedObjects
' ' Do something with each oSketchCurve
'Next
End Sub
Class clsSelect
Private WithEvents oInteractEvents As InteractionEvents
Private WithEvents oSelectEvents As SelectEvents
Private bTooltipEnabled As Boolean
Private ThisApplication As Inventor.Application
Public SelectedObjects As ObjectsEnumerator
Private stillSelecting As Boolean = True
Public Sub WindowSelect(oApp As Inventor.Application)
ThisApplication = oApp
oInteractEvents = ThisApplication.CommandManager.CreateInteractionEvents
oInteractEvents.InteractionDisabled = False
oSelectEvents = oInteractEvents.SelectEvents
'filter for sketch curves
oSelectEvents.AddSelectionFilter(SelectionFilterEnum.kSketchCurveFilter)
oSelectEvents.WindowSelectEnabled = True
bTooltipEnabled = ThisApplication.GeneralOptions.ShowCommandPromptTooltips
ThisApplication.GeneralOptions.ShowCommandPromptTooltips = True
oInteractEvents.StatusBarText = "Select sketch curves. CTRL to deselect, ESC to finish."
oInteractEvents.Start()
While stillSelecting
ThisApplication.UserInterfaceManager.DoEvents()
End While
End Sub
Private Sub oInteractEvents_OnTerminate() Handles oInteractEvents.OnTerminate
ThisApplication.GeneralOptions.ShowCommandPromptTooltips = bTooltipEnabled
oSelectEvents = Nothing
oInteractEvents = Nothing
stillSelecting = False
End Sub
Private Sub oSelectEvents_OnSelect(ByVal JustSelectedEntities As ObjectsEnumerator,
ByVal SelectionDevice As SelectionDeviceEnum, ByVal ModelPosition As Point,
ByVal ViewPosition As Point2d, ByVal View As View) Handles oSelectEvents.OnSelect
SelectedObjects = oSelectEvents.SelectedEntities
End Sub
Private Sub oSelectEvents_OnUnSelect(UnSelectedEntities As ObjectsEnumerator,
SelectionDevice As SelectionDeviceEnum, ModelPosition As Point,
ViewPosition As Point2d, View As View) Handles oSelectEvents.OnUnSelect
SelectedObjects = oSelectEvents.SelectedEntities
End Sub
End Class
Could someone help me figure out how to implement this window selection into my project below? I've also attached resources for you to test out. You'll need to put the parts and code in an assembly for it to work. Thank you so much.
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
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
