- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I'm making something like iCopy that's more suitable for me. In the following code, I add an component to the active document. what I need to do is add the component to the subassembly occurrence that is currently isolated in the active document (double clicked to edit in context). the rule will be running in the subassembly occurrence. Any ideas?
Sub Main()
' Get the active document (must be an assembly)
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
' Ensure the active document is an assembly
If oAsmDoc.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please open an assembly document.", "Error")
Return
End If
' Present a File Selection dialog
Dim oFileDlg As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg)
oFileDlg.InitialDirectory = "C:\" ' Set your initial directory here
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
Dim originalFile As String = oFileDlg.FileName
Dim newFile As String = CreateCopyWithIncrementedName(originalFile)
If newFile = "" Then
MessageBox.Show("Failed to create a copy of the file.", "Error")
Return
End If
' Add the new file as an occurrence in the active assembly
Dim oOccurrence As ComponentOccurrence
oOccurrence = oAsmDoc.ComponentDefinition.Occurrences.Add(newFile, ThisApplication.TransientGeometry.CreateMatrix())
' Ensure the occurrence was added successfully
If oOccurrence Is Nothing Then
MessageBox.Show("Failed to add the selected file as an occurrence.", "Error")
Return
End If
' Make the occurrence adaptive
oOccurrence.Adaptive = True
' Prompt the user to select a plane in the assembly
Dim oPlane As Object
oPlane = ThisApplication.CommandManager.Pick(kWorkPlaneFilter, "Select a plane in the assembly.")
' Ensure the user selected a valid plane
If oPlane Is Nothing Then
MessageBox.Show("No plane selected.", "Error")
Return
End If
' Try to get the "PlaneFront" plane from the occurrence
Dim oOccPlaneFront As WorkPlane
On Error Resume Next
oOccPlaneFront = oOccurrence.Definition.WorkPlanes.Item("PlaneFront")
On Error GoTo 0
' Check if "PlaneFront" was found
If oOccPlaneFront Is Nothing Then
MessageBox.Show("Geometric entity 'PlaneFront' cannot be found. Aborting operation.", "Error")
Return
End If
' Create a proxy for the occurrence's "PlaneFront" plane
Dim oOccPlaneFrontProxy As WorkPlaneProxy
oOccurrence.CreateGeometryProxy(oOccPlaneFront, oOccPlaneFrontProxy)
' Create a flush constraint between the selected plane and "PlaneFront"
Dim oFlushConstraint As FlushConstraint
oFlushConstraint = oAsmDoc.ComponentDefinition.Constraints.AddFlushConstraint(oPlane, oOccPlaneFrontProxy, 0)
' Array to store the four sketch curves
Dim oSketchCurves(3) As Object
Dim curveNames As String() = {"Bottom", "Top", "Left", "Right"}
' Prompt the user to select four sketch curves in the assembly
For i As Integer = 0 To 3
oSketchCurves(i) = ThisApplication.CommandManager.Pick(kSketchCurveFilter, "Select the " & curveNames(i) & " sketch curve in the assembly.")
' Ensure the user selected a valid sketch curve
If oSketchCurves(i) Is Nothing Then
MessageBox.Show("No sketch curve selected for the " & curveNames(i) & " constraint.", "Error")
Return
End If
Next
' Array to store the four axes in the new order
Dim oOccAxes(3) As WorkAxis
Dim axisNames As String() = {"AxisBottom", "AxisTop", "AxisLeft", "AxisRight"}
' Try to get the axes from the occurrence
For i As Integer = 0 To 3
On Error Resume Next
oOccAxes(i) = oOccurrence.Definition.WorkAxes.Item(axisNames(i))
On Error GoTo 0
' Check if the axis was found
If oOccAxes(i) Is Nothing Then
MessageBox.Show("Geometric entity '" & axisNames(i) & "' cannot be found. Aborting operation.", "Error")
Return
End If
Next
' Create proxies for the occurrence's axes and add mate constraints
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
' Notify the user of success
MessageBox.Show("Adaptive occurrence added and constrained successfully.", "Success")
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 counter As Integer = 1
Do
newFile = folder & "\" & baseName & "-" & Right("000" & counter, 3) & "." & extension
counter = counter + 1
Loop While fso.FileExists(newFile)
' Copy the file
fso.CopyFile(originalFile, newFile)
' Return the new file path if successful
If fso.FileExists(newFile) Then
Return newFile
Else
Return ""
End If
End Function
Solved! Go to Solution.
Link copied