Message 1 of 4
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Solved! Go to Solution.