Editing component in sub assembly error with VBA

[Olsndot]

Hi,

I have trouble with elementary code in VBA.
That code is to edit component as shown in the below.
It works in top assembly,but doesn't work in editing sub assembly from within top assembly.

What exactly needs changed to allow this to work?

Sub EDIT_COMPONENT()

Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveEditDocument

Dim oAsmCompDef As ComponentDefinition
Set oAsmCompDef = oAsmDoc.ComponentDefinition

Dim oOcc As ComponentOccurrence
Set oOcc = oAsmCompDef.Occurrences.Item(1)
oOcc.EDIT
End Sub

[JaneFan]

Hey @Olsndot ,

Editing a sub occurrence in API can be coded like this. Code need be adjusted as your need.

Sub EDIT_COMPONENT()

Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveDocument

Dim oAsmCompDef As ComponentDefinition
Set oAsmCompDef = oAsmDoc.ComponentDefinition

Dim oOcc As ComponentOccurrence
Set oOcc = oAsmCompDef.Occurrences.Item(1).SubOccurrences(1)

oOcc.Edit
End Sub

[Olsndot]

Hi,@JaneFan
Thank you for reply,but that is different than what I was expecting.
I'm sorry I didn't explain it enough and pardon my broken English..
I want to edit component in sub assembly while editing sub assembly as shown in the figure.
Problem I faced is getting error at the

oOcc.Edit

Is it possible to resolve the the problem and edit component in sub assembly while editing?

[JaneFan · Accepted solution]

Hey @Olsndot ,

Here is updated code if you are getting document from ActiveEditDocument. Thanks for Rocky's suggestion.
Here is the updated code:

Sub EditUpdate()

Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveEditDocument

Dim oEditOccu As ComponentOccurrence
Dim oTopDoc As AssemblyDocument
If Not (oAsmDoc Is ThisApplication.ActiveDocument) Then
Set oTopDoc = ThisApplication.ActiveDocument
Set oEditOccu = oTopDoc.ComponentDefinition.ActiveOccurrence
End If

Dim oOcc As ComponentOccurrence
Set oOcc = oEditOccu.SubOccurrences(1)

oOcc.edit
End Sub

[Olsndot]

Hi JaneFan,

That is exactly what I'm expecting!  

Thank you. I appreciate your help.

[tonythm]

Hello Jane Fan,

How to run VBA user parameter of the part component in assembly. Can you hepl me.

I have the code from VBA excel to run into inventor, but not working.

Sub RunIAM()

Dim oWkbk As Workbook
Set oWkbk = ThisWorkbook

Dim oSheet As Worksheet
Set oSheet = oWkbk.ActiveSheet

Dim oInv As Inventor.Application
Set oInv = GetObject(, "Inventor.Application")

Dim oDoc As Document
Set oDoc = oInv.ActiveDocument

Dim oDocAssy As AssemblyDocument
Set oDocAssy = oInv.ActiveDocument

' Define sheet name where information resides
Dim sSheetName As String
sSheetName = "Output Parameter"

' Set range where parameter names reside in sheet
Dim sParamRange As String
sParamRange = "A2:A81"

Dim oCompDef As ComponentDefinition
' Get component definition
Set oCompDef = oDoc.ComponentDefinition

Dim oAsmCompDef As AssemblyComponentDefinition
Set oAsmCompDef = oDocAssy.ComponentDefinition

Dim oOcc As ComponentOccurrence
Set oOcc = oAsmCompDef.Occurrences.Item(1)

'define parameters
Dim oUserParams As UserParameters
Set oUserParams = oCompDef.Parameters.UserParameters
Dim param As Parameter

Dim oCell As Range
' Loop through each parameter listed in sheet
For Each oCell In oSheet.Range(sParamRange)
' Parse through parameters and check to see if parameter name matches current parameter from Excel
For Each oParam In oUserParams
' If names match, copy value and units from Excel into parameter expression
If oCell.Value = oParam.Name Then
oParam.Expression = oCell.Offset(0, 1).Value & oCell.Offset(0, 2).Value
End If
Next oParam
Next oCell

'Suppress feature
If Range("K6").Value = "L" Then
Dim oHole4 As Inventor.PartFeature
Set oHole4 = oAsmCompDef.Occurrences.Item(1).Features("Hole4")
oHole4.Suppressed = True
Dim oHole5 As Inventor.PartFeature
Set oHole5 = oDocPart.ComponentDefinition.Features("Hole5")
oHole5.Suppressed = False
ElseIf Range("K6").Value = "R" Then
Set oHole4 = oAsmCompDef.Occurrences.Item(1).Features("Hole4")
oHole4.Suppressed = False
Set oHole5 = oDocPart.ComponentDefinition.Features("Hole5")
oHole5.Suppressed = True
End If

If Range("K8").Value = "DE" Then
Dim oMirror1 As Inventor.PartFeature
Set oMirror1 = oDocPart.ComponentDefinition.Features("Mirror1")
oMirror1.Suppressed = True
Dim oHole3 As Inventor.PartFeature
Set oHole3 = oDocPart.ComponentDefinition.Features("Hole3")
oHole3.Suppressed = False
ElseIf Range("K8").Value = "NDE" Then
Set oMirror1 = oDocPart.ComponentDefinition.Features("Mirror1")
oMirror1.Suppressed = False
Set oHole3 = oDocPart.ComponentDefinition.Features("Hole3")
oHole3.Suppressed = True
End If

If Range("K4").Value = "D1328" Then
Dim oHole6 As Inventor.PartFeature
Set oHole6 = oDocPart.ComponentDefinition.Features("Hole6")
oHole6.Suppressed = True
Dim oExtrude3 As Inventor.PartFeature
Set oExtrude3 = oDocPart.ComponentDefinition.Features("Extrusion3")
oExtrude3.Suppressed = True
Else
Set oHole6 = oDocPart.ComponentDefinition.Features("Hole6")
oHole6.Suppressed = False
Set oExtrude3 = oDocPart.ComponentDefinition.Features("Extrusion3")
oExtrude3.Suppressed = False
End If

Set oExcel = Nothing

' Update part/assembly
oDoc.Update
ActiveWorkbook.Save

End Sub

Thank you.