Attributes help

[NachitoMax]

Hi

Can anyone help? Basically I have a part in an assembly which has an attribute set called NS_Lock

The assembly has many occurrences in my main assembly. The attribute is attached to a part inside the assembly, not on the assembly itself.

I need to loop through the occurrences and find only the parts with the attributes and write the name to the immediate window. The loop has to happen at assembly level.


I have tried various code snippets but nothing is working 😞




Hope someone can help



Thanks

Nigel

[YuhanZhang]

Hope bleow VBA code can help you:

Sub FindPartFromAssembly()
    Dim oAssy As AssemblyDocument
    Set oAssy = ThisApplication.ActiveDocument
    
    Dim oCompDef As AssemblyComponentDefinition
    Set oCompDef = oAssy.ComponentDefinition
    
    Dim oOccus As ComponentOccurrencesEnumerator
    Set oOccus = oCompDef.Occurrences.AllLeafOccurrences
 
    Dim odoc As PartDocument
    Dim oOccu As ComponentOccurrence
    Dim oAttributeMgr As AttributeManager
    Dim oAttributeSets As AttributeSetsEnumerator
    
    For Each oOccu In oOccus
        Set odoc = oOccu.Definition.Document
        Set oAttributeMgr = odoc.AttributeManager
        Set oAttributeSets = oAttributeMgr.FindAttributeSets("NS_Lock")
        
        If oAttributeSets.Count <> 0 Then
            Dim oBrowserPane As BrowserPane
            Set oBrowserPane = oAssy.BrowserPanes("Model")
            
            Dim oNode As BrowserNode
            Set oNode = oBrowserPane.GetBrowserNodeFromObject(oOccu)
            
            Debug.Print oNode.FullPath
            Debug.Print odoc.FullDocumentName
            Exit For
        End If
    Next
End Sub

[NachitoMax]

Hi

Thanks for the code. I get an error on this line-

Set odoc = oOccu.Definition.Document

The error says-
Run-time error '-2147467259 (80004005)
Method 'Definition' of object 'ComponentOccurrence' failed


Any ideas?

Many Thanks

Nigel

[YuhanZhang]

The VBA code does not set error checking, so you can add error checking to avoid the failure like below:

Sub FindPartFromAssembly()
    Dim oAssy As AssemblyDocument
    Set oAssy = ThisApplication.ActiveDocument
    
    Dim oCompDef As AssemblyComponentDefinition
    Set oCompDef = oAssy.ComponentDefinition
    
    Dim oOccus As ComponentOccurrencesEnumerator
    Set oOccus = oCompDef.Occurrences.AllLeafOccurrences
 
    Dim odoc As PartDocument
    Dim oOccu As ComponentOccurrence
    Dim oAttributeMgr As AttributeManager
    Dim oAttributeSets As AttributeSetsEnumerator
    On Error GoTo findnext:
    For Each oOccu In oOccus
        Set odoc = oOccu.Definition.Document
        Set oAttributeMgr = odoc.AttributeManager
        Set oAttributeSets = oAttributeMgr.FindAttributeSets("NS_Lock")
        
        If oAttributeSets.Count <> 0 Then
            Dim oBrowserPane As BrowserPane
            Set oBrowserPane = oAssy.BrowserPanes("Model")
            
            Dim oNode As BrowserNode
            Set oNode = oBrowserPane.GetBrowserNodeFromObject(oOccu)
            
            Debug.Print oNode.FullPath
            Debug.Print odoc.FullDocumentName
            Exit For
        End If
findnext:
    Next
End Sub

[NachitoMax]

Hi

i have tried this code and i cannot get it to work. I have a different routine from the API that will get/set attributes. When i run this in the mail assembly, i can set an attribute to a part and get the attribute name back. I can also run the code in the sub assembly and do the same but i cannot get the attribute name from the part in the sub assembly. this is the code i am using from the API-

Public Sub SetAndGetAttribute()
    ' Select an entity.
    Dim oSelectedObject As Object
    Set oSelectedObject = ThisApplication.CommandManager.Pick(kAllEntitiesFilter, "Select an entity.")

    ' Make sure the selected object supports attributes by attempting
    ' to use the AttributeSets property of the object.
    Dim oAttribSets As AttributeSets
    On Error Resume Next
    Set oAttribSets = oSelectedObject.AttributeSets
    If Err Then
        MsgBox "The selected object does not support attributes."
        Exit Sub
    End If
    On Error GoTo 0

    Dim sNewValue As String
    Dim oAttribSet As AttributeSet
    Dim oAttrib As Inventor.Attribute
    ' Check to see if the object already has an attribute set named "AttribTest".
    If oAttribSets.NameIsUsed("AttribTest") Then
        ' Get a reference to the existing attribute set.
        Set oAttribSet = oAttribSets.Item("AttribTest")
        
        ' Get a reference to the existing attribute.
        Set oAttrib = oAttribSet.Item("Attrib")
        
        ' Display the current value and allow the user to specify a new value.
        sNewValue = InputBox("Edit existing value", "Modify Existing Attribute", _
                                oAttrib.Value)
                                
        ' If the value's different, change the value of the attribute.
        If sNewValue <> "" And sNewValue <> oAttrib.Value Then
            oAttrib.Value = sNewValue
        End If
    Else
        ' Get the value to assign to the attribute.
        sNewValue = InputBox("Specify attribute value", "Create Attribute")
        
        ' If a value was entered, create a new attribute set and attribute.
        If sNewValue <> "" Then
            ' Create a new attribute set with the name "AttribTest".
            Set oAttribSet = oAttribSets.Add("AttribTest")
           
            ' Create a new attribute named "Attrib" and assign the value.
            Set oAttrib = oAttribSet.Add("Attrib", kStringType, sNewValue)
        End If
    End If
End Sub

when i run your code (with the AttributeSet names above, i cannot get a result at all 😞

Thanks

Nigel