Turn off Translucent using VBA

[Anonymous]

Hi All,

I'm trying to make a translucent part file to a opaque part file by using the below code

    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument
    oDocument.ActiveRenderStyle.Opacity = 1    'making the body opaque

But it doesnot help.Can someone please let me know how to do it through code.

PS: attached is the process of doing it manually

Thank You

[Anonymous · Accepted solution]

Like this?

Public Sub TranslucentTest()
    Dim app As Inventor.Application
    Set app = ThisApplication
    Dim partDoc As PartDocument
    Set partDoc = app.ActiveDocument
    Dim oWorkSurface As WorkSurface
    Set oWorkSurface = partDoc.ComponentDefinition.WorkSurfaces.Item(1)
    oWorkSurface.Translucent = False
   
End Sub

[Anonymous]

Thank You.

I works as expected

[jalexander]

This works for part docs only, is there any way we can improve upon this to change all part surfaces in an assembly file instead of opening each part that has a surface individually?

[Anonymous]

Public Sub TranslucentTest()
      Dim app As Inventor.Application
      Set app = ThisApplication
        Dim oModel As AssemblyDocument
        Set oModel = ThisApplication.ActiveDocument '.iam file
        'or open the assembly file as below
        'Set oModel = ThisApplication.Documents.Open("D:\TestAssm.iam", False)
       'then identify each part in the assembly & set the surface to opaque
      Dim partDoc As PartDocument
      For i = 1 To oModel.ComponentDefinition.Occurrences.Count
       Set partDoc = oModel.ComponentDefinition.Occurrences.Item(i).Definition.Document
        Dim oWorkSurface As WorkSurface
        Set oWorkSurface = partDoc.ComponentDefinition.WorkSurfaces.Item(1)
        oWorkSurface.Translucent = False
       Next
  
End Sub

////////////////

The above code identifies each part in the assembly & changes its surface

Hope this helps

[dwweekly]

I tried it,

I have inventor 2012

 got an error

Runtime error '-2147467259 (80004005)':

Method 'Item' of object 'WorkSurfaces' failed

it highlighted

Set oWorkSurface = partDoc.ComponentDefinition.WorkSurfaces.Item(1)

any suggestions?

[dwweekly]

I found that it does not work in multiple sub assemblies, is there a change in code to go down thru multiple assemblies?

[dwweekly]

also it hangs on solid models...I think

[sebastien.forman]

Hi,

Please find my code with recursive functionality.

Public Sub TranslucentToOpaqueAllParts()
    Dim app As Inventor.Application
    Set app = ThisApplication
    Dim oModel1 As AssemblyDocument
    Set oModel1 = ThisApplication.ActiveDocument
    
    TranslucentToOpaqueAllPartsRecurcivePart oModel1
End Sub
Private Sub TranslucentToOpaqueAllPartsRecurcivePart(oModel As AssemblyDocument)
    Dim partDoc As Document
        For i = 1 To oModel.ComponentDefinition.Occurrences.Count
            Set partDoc = oModel.ComponentDefinition.Occurrences.Item(i).Definition.Document
                If partDoc.DocumentType = kPartDocumentObject Then
                    Dim oWorkSurface As WorkSurface
                    Set oWorkSurface = partDoc.ComponentDefinition.WorkSurfaces.Item(1)
                    oWorkSurface.Translucent = False
                Else
                    changeInIamToOpaque partDoc
                End If
        Next
End Sub

[Stooie]

Obvious, Itinerant every surface.

Public Sub TranslucentToOpaqueAllParts()
Dim app As Inventor.Application
Set app = ThisApplication
Dim oModel1 As AssemblyDocument
Set oModel1 = ThisApplication.ActiveDocument

TranslucentToOpaqueAllPartsRecurcivePart oModel1
End Sub
Private Sub TranslucentToOpaqueAllPartsRecurcivePart(oModel As AssemblyDocument)
Dim partDoc As Document
For i = 1 To oModel.ComponentDefinition.Occurrences.Count
Set partDoc = oModel.ComponentDefinition.Occurrences.Item(i).Definition.Document
If partDoc.DocumentType = kPartDocumentObject Then
Dim oWorkSurface As WorkSurface
For Each oWorkSurface In partDoc.ComponentDefinition.WorkSurfaces
oWorkSurface.Translucent = False
Next
Else
'changeInIamToOpaque partDoc
End If
Next
End Sub