Stuck in Loop

Stuck in Loop

HogueOne
Advocate Advocate
514 Views
3 Replies
Message 1 of 4

Stuck in Loop

HogueOne
Advocate
Advocate

can anybody help me learn why I'm getting stuck in a loop? I want the user to keep selecting an entity called "bottom curve" until they're satisfied with the selection, the press escape to continue with the code, but I keep getting stuck in a loop where it infinitely asks me to select a bottom curve even if I press escape around line 126. I could really use a hand...

 

 

Sub Main()
    Dim oAsmDoc As AssemblyDocument = GetActiveAssemblyDocument()
    If oAsmDoc Is Nothing Then Exit Sub

    Dim selectedFile As String = SelectFile()
    If selectedFile = "" Then Exit Sub

    Dim newFile As String = CreateCopyWithIncrementedName(selectedFile)
    If newFile = "" Then
        MessageBox.Show("Failed to create a copy of the file.", "Error")
        Exit Sub
    End If

    Dim oOccurrence As ComponentOccurrence = AddOccurrenceToAssembly(oAsmDoc, newFile)
    If oOccurrence Is Nothing Then Exit Sub

    oOccurrence.Adaptive = True

    Dim oPlane As Object = SelectPlane()
    If oPlane Is Nothing Then Exit Sub

    Dim oOccPlaneFront As WorkPlane = GetOccurrencePlane(oOccurrence, "PlaneFront")
    If oOccPlaneFront Is Nothing Then Exit Sub

    CreateFlushConstraint(oAsmDoc, oPlane, oOccurrence, oOccPlaneFront)

    Dim oSketchCurves() As Object = SelectSketchCurves()
    If oSketchCurves Is Nothing Then Exit Sub

    Dim oOccAxes() As WorkAxis = GetOccurrenceAxes(oOccurrence)
    If oOccAxes Is Nothing Then Exit Sub

    CreateMateConstraints(oAsmDoc, oSketchCurves, oOccurrence, oOccAxes)

    MessageBox.Show("Adaptive occurrence added and constrained successfully.", "Success")
End Sub

Function GetActiveAssemblyDocument() As AssemblyDocument
    Dim oAsmDoc As AssemblyDocument = ThisApplication.ActiveDocument
    If oAsmDoc.DocumentType <> kAssemblyDocumentObject Then
        MessageBox.Show("Please open an assembly document.", "Error")
        Return Nothing
    End If
    Return oAsmDoc
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 file to insert as an occurrence"
    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 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 SelectPlane() As Object
    Dim oPlane As Object
    oPlane = ThisApplication.CommandManager.Pick(kWorkPlaneFilter, "Select a plane in the assembly.")
    
    If oPlane Is Nothing Then
        MessageBox.Show("No plane selected.", "Error")
    End If
    
    Return oPlane
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

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

Function SelectSketchCurves() As Object()
    Dim oSketchCurves(3) As Object
    Dim curveNames As String() = {"Bottom", "Top", "Left", "Right"}
    
    For i As Integer = 0 To 3
        ThisApplication.StatusBarText = "Select the " & curveNames(i) & " sketch curve"
        
        If i = 0 Then ' For the Bottom curve
            Dim lastSelectedCurve As Object = Nothing
            Do
                Try
                    Dim selectedCurve As Object = ThisApplication.CommandManager.Pick(kSketchCurveFilter, "Select the " & curveNames(i) & " sketch curve (Press Esc to finish)")
                    If selectedCurve IsNot Nothing Then
                        lastSelectedCurve = selectedCurve
                        MessageBox.Show("Bottom curve selected. You can select another curve or press Esc to finish.", "Selection")
                    End If
                Catch ex As Exception
                    ' User pressed Esc
                    Exit Do
                End Try
            Loop While True ' Continue until Esc is pressed
            
            If lastSelectedCurve Is Nothing Then
                MessageBox.Show("No bottom curve was selected. Operation cannot continue.", "Error")
                Return Nothing
            Else
                oSketchCurves(i) = lastSelectedCurve
                MessageBox.Show("Bottom curve selection finished. The last selected curve will be used for the constraint.", "Selection Complete")
            End If
        Else ' For Top, Left, and Right curves
            Try
                oSketchCurves(i) = ThisApplication.CommandManager.Pick(kSketchCurveFilter, "Select the " & curveNames(i) & " sketch curve")
                
                If oSketchCurves(i) Is Nothing Then
                    MessageBox.Show("No sketch curve selected for the " & curveNames(i) & " constraint.", "Error")
                    Return Nothing
                Else
                    MessageBox.Show("Curve selected for " & curveNames(i) & ".", "Selection Complete")
                End If
            Catch ex As Exception
                MessageBox.Show("Selection cancelled for " & curveNames(i) & " curve.", "Selection Cancelled")
                Return Nothing
            End Try
        End If
    Next
    
    Return oSketchCurves
End Function

Function GetOccurrenceAxes(oOccurrence As ComponentOccurrence) As WorkAxis()
    Dim oOccAxes(3) As WorkAxis
    Dim axisNames As String() = {"AxisBottom", "AxisTop", "AxisLeft", "AxisRight"}
    
    For i As Integer = 0 To 3
        On Error Resume Next
        oOccAxes(i) = oOccurrence.Definition.WorkAxes.Item(axisNames(i))
        On Error GoTo 0
        
        If oOccAxes(i) Is Nothing Then
            MessageBox.Show("Geometric entity '" & axisNames(i) & "' cannot be found. Aborting operation.", "Error")
            Return Nothing
        End If
    Next
    
    Return oOccAxes
End Function

Sub CreateMateConstraints(oAsmDoc As AssemblyDocument, oSketchCurves() As Object, oOccurrence As ComponentOccurrence, oOccAxes() As WorkAxis)
    Dim oConstraints(3) As MateConstraint
    For i As Integer = 0 To 3
        Dim oOccAxisProxy As WorkAxisProxy
        oOccurrence.CreateGeometryProxy(oOccAxes(i), oOccAxisProxy)
        
        oConstraints(i) = oAsmDoc.ComponentDefinition.Constraints.AddMateConstraint(oSketchCurves(i), oOccAxisProxy, 0)
    Next
End Sub

Function CreateCopyWithIncrementedName(originalFile As String) As String
    Dim fso As Object
    fso = 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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
    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

 

0 Likes
Accepted solutions (1)
515 Views
3 Replies
Replies (3)
Message 2 of 4

WCrihfield
Mentor
Mentor

There should always be something like:

If selectedCurve Is Nothing Then Exit Do

...if in a 'Do...Loop'.  Else, if in a While...End While, use 'Exit While'.  If in a 'For Each' or 'For i = 1 to' type loop, use 'Exit For'.  And so on, depending on the type of loop.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

Message 3 of 4

Frederick_Law
Mentor
Mentor
                Catch ex As Exception
                    ' User pressed Esc
                    Exit Do

This catch exception, not ESC key.

0 Likes
Message 4 of 4

Michael.Navara
Advisor
Advisor
Accepted solution

As @WCrihfield mentions above you need to add Exit Do in your loop like this

 

Line120:
Do
	Try
		Dim selectedCurve As Object = ThisApplication.CommandManager.Pick(kSketchCurveFilter, "Select the " & curveNames(i) & " sketch curve (Press Esc to finish)")
		If selectedCurve IsNot Nothing Then
			lastSelectedCurve = selectedCurve
			MessageBox.Show("Bottom curve selected. You can select another curve or press Esc to finish.", "Selection")
		Else
			Exit Do
		End If
	Catch ex As Exception
		' User pressed Esc
		Exit Do
	End Try
Loop While True ' Continue until Esc is pressed