Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

SetIncludeStatus in DrawingView with SubAssembly

martin_winkler
Advisor

SetIncludeStatus in DrawingView with SubAssembly

martin_winkler
Advisor
Advisor

I want to set the IncludeStatus of Workplanes with the API for some parts or assemblies.

In the first level of the referenced assembly this works fine.

Then i use TraverseAssembly to do the same in second or deeper levels of the assembly.

In this case i get an error in the TraverseAssembly in line:

Call oSheet.DrawingViews(1).SetIncludeStatus(oWPpx, True)

 

3DCS-GmbH_Samstag, 7. November 2020_21h00m02s_001_.jpg 

Here is the code i wrote in VBA:

Public Sub SetIncludeStatusFromAsm()
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    Dim intWorkplane As Integer
    intWorkplane = 1 'YZ-Plane

    'Get referenced Assembly document
    Dim strFileName As String
    'File in which the workplane is to be included
    strFileName = "testfile.ipt" 'testfile.iam" 
    Dim oAsm As AssemblyDocument
    Set oAsm = oDrawDoc.ReferencedDocuments(1)
    Dim oCompDef As ComponentDefinition
    Dim oDoc As Document
    Dim oOcc As ComponentOccurrence
    Dim oOccs As ComponentOccurrences
    Set oOccs = oAsm.ComponentDefinition.Occurrences
    'Search for the strFileName occurence    
    For Each oOcc In oOccs
     Debug.Print (oOcc.Name)
      If FileNameFromPath(oOcc.ReferencedDocumentDescriptor.FullDocumentName) = strFileName Then
       Set oCompDef = oOcc.Definition
       Dim oWP As WorkPlane
       'Get YZ WorkPlane, suppose it's perpendicular to the view
       Set oWP = oCompDef.WorkPlanes.item(intWorkplane)
       'Create proxy object
       Dim oWPpx As WorkPlaneProxy
       Call oOcc.CreateGeometryProxy(oWP, oWPpx)
       'SetIncludeStatus
       Call oSheet.DrawingViews(1).SetIncludeStatus(oWPpx, True)
      Else
       If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
         Call TraverseAssembly(oOcc.Definition.Occurrences, strFileName, intWorkplane, oSheet)
       End If
      End If
    Next
End Sub

Sub TraverseAssembly(Occurrences As ComponentOccurrences, strFileName As String, intWorkplane As Integer, oSheet As Sheet)
    ' Iterate through all of the occurrence in this collection.  This
    ' represents the occurrences at the top level of an assembly.
    Dim oOcc As ComponentOccurrence
    For Each oOcc In Occurrences
        Debug.Print (oOcc.Name) & " - " & FileNameFromPath(oOcc.ReferencedDocumentDescriptor.FullDocumentName)
        If FileNameFromPath(oOcc.ReferencedDocumentDescriptor.FullDocumentName) = strFileName Then
         Dim oCompDef As ComponentDefinition
         Set oCompDef = oOcc.Definition
         Dim oWP As WorkPlane
         'Get WorkPlane 1 (YZ), suppose it's perpendicular to the view
         Set oWP = oCompDef.WorkPlanes.item(intWorkplane)
            'Create proxy object
            Dim oWPpx As WorkPlaneProxy
            Call oOcc.CreateGeometryProxy(oWP, oWPpx)
            Call oSheet.DrawingViews(1).SetIncludeStatus(oWPpx, True)
        End If
        
        If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
            Call TraverseAssembly(oOcc.SubOccurrences, strFileName, intWorkplane, oSheet)
        End If
    Next
End Sub

Public Function FileNameFromPathExt(strFullPath As String) As String
    FileNameFromPathExt = Right(strFullPath, Len(strFullPath) - InStrRev(strFullPath, "\"))
    FileNameFromPathExt = Left(FileNameFromPathExt, InStrRev(FileNameFromPathExt, ".") - 1)
End Function

 

Did anyone have an idea?

0 Likes
Reply
Accepted solutions (2)
597 Views
2 Replies
Replies (2)

JhoelForshav
Mentor
Mentor
Accepted solution

Hi @martin_winkler 

If you want to include the plane from partfiles named "testfile.ipt" you could just traverse all LeafOccurrences in the assembly. I think this should be enough to get the result you want :slightly_smiling_face:

 

Sub SetIncludeStatusFromAsm()
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    Dim oView As DrawingView
    Set oView = oSheet.DrawingViews(1)
    Dim oAsm As AssemblyDocument
    Set oAsm = oView.ReferencedDocumentDescriptor.ReferencedDocument
    Dim intWorkplane As Integer
    intWorkplane = 1
    Dim strFileName As String
    strFileName = "testfile.ipt"
    Dim oOcc As ComponentOccurrence
    Dim oDoc As Document
    For Each oOcc In oAsm.ComponentDefinition.Occurrences.AllLeafOccurrences
        Set oDoc = oOcc.ReferencedDocumentDescriptor.ReferencedDocument
        If Right(oDoc.FullFileName, Len(oDoc.FullFileName) - InStrRev(oDoc.FullFileName, "\")) = strFileName Then
            Dim oWP As WorkPlane
            Set oWP = oDoc.ComponentDefinition.WorkPlanes(intWorkplane)
            Dim oWPprox As WorkPlaneProxy
            Call oOcc.CreateGeometryProxy(oWP, oWPprox)
            Call oView.SetIncludeStatus(oWPprox, True)
        End If
    Next
End Sub

 

0 Likes

martin_winkler
Advisor
Advisor
Accepted solution

@JhoelForshav 

Hi Jhoel, thank you for the good advice. I have now done that with AllReferencedOccurrences
and that seems to work for ipt and iam now.

Here is the complete code to use it from other context:

 

Sub SetIncludeStatusWorkplane()
 Call SetIncludeStatusFromAsm("test.ipt", 1, True)
 'Call SetIncludeStatusFromAsm("test.iam", 1, True)
End Sub

Public Sub SetIncludeStatusFromAsm(strFileName As String, intWorkplane As Integer, boolSetWorkplane As Boolean)
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    Dim oAsm As AssemblyDocument
    Set oAsm = oDrawDoc.ReferencedDocuments(1)
    Dim oCompDefAsm As ComponentDefinition
    Set oCompDefAsm = oAsm.ComponentDefinition
    Dim oDoc As Document
    Dim oOcc As ComponentOccurrence
    Dim oOccs As ComponentOccurrences
    Set oOccs = oAsm.ComponentDefinition.Occurrences
    Dim oOccRefs As ComponentOccurrencesEnumerator
    Set oOccRefs = oOccs.AllReferencedOccurrences(oCompDefAsm)
        
    For Each oOcc In oOccRefs
      'Debug.Print (oOcc.Name)
      If FileNameFromPath(oOcc.ReferencedDocumentDescriptor.FullDocumentName) = strFileName Then
        Set oCompDef = oOcc.Definition
        Dim oWP As WorkPlane
        'Get YZ WorkPlane, suppose it's perpendicular to the view
        Set oWP = oCompDef.WorkPlanes.item(intWorkplane)
        'Create proxy object
        Dim oWPpx As WorkPlaneProxy
        Call oOcc.CreateGeometryProxy(oWP, oWPpx)
        'SetIncludeStatus
        Call oSheet.DrawingViews(1).SetIncludeStatus(oWPpx, boolSetWorkplane)
       End If
      Next
End Sub

Public Function FileNameFromPath(strFullPath As String) As String
    Dim i As Integer
    For i = Len(strFullPath) To 1 Step -1
        If Mid(strFullPath, i, 1) = "\" Then
            FileNameFromPath = Right(strFullPath, Len(strFullPath) - i)
            Exit For
        End If
    Next
End Function

 

0 Likes