Problem with importing assembly files and taking screenshots using VBA

hansverdolaga · ‎10-04-2020

Hello,

As a background to this code, I am automating a process in Excel that takes CAD files (SLDPRT, SLDASM, ipt, iam, stp etc.), and creates 10 screenshots at different angles. At the moment, my code works perfectly fine, except in the case of assembly files, where it seems to load the components without constraining them properly. If I import / open the assembly files manually, the constraints load up fine.

Sub ImportCAD(Path As String)
    'Open Inventor
    Dim invApp As Inventor.Application
    Set invApp = GetObject(, "Inventor.Application")
    invApp.Visible = True
    
    'Set file path and object parameters
    Dim oDoc As Variant
    
    If InStrRev(Path, ".ipt") <> 0 Or InStrRev(Path, ".iam") <> 0 Then
        GoTo OpenInvFile
        Exit Sub
    Else
        GoTo ImportCADFile
        Exit Sub
    End If
    Exit Sub
    
OpenInvFile:
    Set oDoc = invApp.Documents.Open(Path, True)
    Exit Sub

ImportCADFile:
    Set oDoc = invApp.Documents.Add(kPartDocumentObject, , True)
    
    Dim oPartCompDef As Variant
    Set oPartCompDef = oDoc.ComponentDefinition
    
    Dim oImportedGenericCompDef As ImportedGenericComponentDefinition
    Set oImportedGenericCompDef = oPartCompDef.ReferenceComponents.ImportedComponents.CreateDefinition(Path)
    
    oImportedGenericCompDef.ReferenceModel = False
    oImportedGenericCompDef.IncludeAll
    
    Dim oImportedComp As ImportedComponent
    Set oImportedComp = oPartCompDef.ReferenceComponents.ImportedComponents.Add(oImportedGenericCompDef)
    
End Sub

Sub CreateScreenshots(PartDir)
    'Value of pi
    Dim pi As Double
    pi = Math.Atn(1) * 4
    
    'Image processing library
    Dim ImgF As WIA.ImageFile
    Dim ImgP As WIA.ImageProcess
    
    Set invApp = GetObject(, "Inventor.Application")
    invApp.Visible = True
    
    Dim oDoc As Document
    Set oDoc = invApp.ActiveDocument
    invApp.ActiveView.DisplayMode = kShadedWithEdgesRendering
    
    Dim centerPoint As Variant
    Set centerPoint = GetRangeBoxCenter(oDoc)
    
    Call SetCameraOrientation(centerPoint, kIsoTopRightViewOrientation)
    
    'Get inventor camera and apply parameters
    Dim oCamera As camera
    Set oCamera = invApp.ActiveView.camera
    
    Call oCamera.Fit
    Call oCamera.ApplyWithoutTransition
    
    Dim offsetRad As Double
    offsetRad = 12 * pi / 180
    
    Dim YAxis As Vector
    Set YAxis = invApp.TransientGeometry.CreateVector(0, 1, 0)
    
    Dim XAxis As Vector
    Set XAxis = invApp.TransientGeometry.CreateVector(1, 0, 0)
    
    Dim YVector As UnitVector
    Set YVector = invApp.TransientGeometry.CreateUnitVector(0, 1, 0)
    
    Dim minusYVector As UnitVector
    Set minusYVector = invApp.TransientGeometry.CreateUnitVector(0, -1, 0)
    
    Dim XVector As UnitVector
    Set XVector = invApp.TransientGeometry.CreateUnitVector(1, 0, 0)
    
    'Views array for front, top, right
    Dim ISOviews As Variant
    ISOviews = Array(kFrontViewOrientation _
                    , kTopViewOrientation _
                    , kRightViewOrientation)
                    
    'Generate images for front, top, right
    For j = 0 To 2
        imagePath = PartDir & "\Artworks\Screenshot_" & (j + 1) & ".bmp"
        
        Call SetCameraOrientation(centerPoint, ISOviews(j))
        Call Save_JPG(oCamera, imagePath)
        Kill imagePath
    Next j
    
    'Generate images for upright angles
    Call SetCameraOrientation(centerPoint, kIsoTopRightViewOrientation)
    For i = 1 To 7
        If i = 6 Then
            Call RotateCam(oCamera, offsetRad * 3, XAxis, centerPoint, YVector)
        End If
    
        Call RotateCam(oCamera, offsetRad * i, YAxis, centerPoint, YVector)
        
        If i = 1 Or i = 3 Then
            GoTo NextFor
        End If
        
        imagePath = PartDir & "\Artworks\Screenshot_" & (i + 3) & ".bmp"
        
        Call Save_JPG(oCamera, imagePath)
        Kill imagePath
NextFor:
    Next i
    
    'Generate images for upside down angles
    Call SetCameraOrientation(centerPoint, kFrontViewOrientation)
    Call RotateCam(oCamera, (180 * pi / 180), XAxis, centerPoint, minusYVector)
    For k = 9 To 10
        Call RotateCam(oCamera, 200 * pi * (k - 9) / 180, YAxis, centerPoint, minusYVector)
        
        imagePath = PartDir & "\Artworks\Screenshot_" & (k - (5 - (k - 9) * 1)) & ".bmp"
        
        Call Save_JPG(oCamera, imagePath)
        Kill imagePath
    Next k
    
    'Reset view
    Call SetCameraOrientation(centerPoint, kIsoTopRightViewOrientation)
    
End Sub

Private Sub Save_JPG(camera, destination) 'Bitmap save and convert to JPG subroutine
    Call camera.SaveAsBitmap(destination, 1080, 1080)
    
    Set ImgF = New WIA.ImageFile
    Call ImgF.LoadFile(destination)
    Set ImgP = New WIA.ImageProcess
    With ImgP
        .Filters.Add .FilterInfos!Convert.FilterID
        .Filters.Item(1).Properties!FormatID.Value = wiaFormatJPEG
        .Filters.Item(1).Properties!Quality.Value = 90
        Set ImgF = .Apply(ImgF)
    End With
    Call ImgF.SaveFile(Replace(destination, ".bmp", ".jpg"))
End Sub

Private Sub SetCameraOrientation( _
    ByVal targetPoint As Variant, _
    ByVal viewOrientation As ViewOrientationTypeEnum) '
    
    Dim camera As Inventor.camera
    Set camera = invApp.ActiveView.camera
    
    camera.ViewOrientationType = viewOrientation
    camera.Target = targetPoint
    
    Call camera.Fit
    Call camera.ApplyWithoutTransition

End Sub

Private Sub RotateCam( _
    camera As camera, _
    ByVal offsetRad As Double, _
    rotAxis As Vector, _
    center As Variant, _
    upVector As UnitVector)

    Dim matrix As matrix
    Set matrix = invApp.TransientGeometry.CreateMatrix
    
    Call matrix.SetToRotation(offsetRad, rotAxis, center)
    
    Dim newEye As Variant
    Set newEye = camera.Eye
    
    Call newEye.TransformBy(matrix)
    
    camera.Eye = newEye
    
    camera.upVector = upVector
    
    Call camera.ApplyWithoutTransition
    
End Sub

Thanks,

Hans

Anonymous · ‎10-05-2020

I wrote some code a while back that deletes all existing mates and grounds all of the components in the assembly, I think that this would work well for you, as it will lock everything in the correct position. You could run this rule first, then do your screenshots.

https://clintbrown.co.uk/2018/10/01/ilogic-delete-all-mates-joints-ground/

hansverdolaga · ‎10-10-2020

I'll try it out soon and will let you know, thanks!

hansverdolaga · ‎10-15-2020

Hello,

I tried inputting your code, but unfortunately it doesn't work because in my code I am importing STEP parts into a new Part environment, not an Assembly environment because some of the CAD files I'm taking screenshots of are single body; others are multibody.

The VBA doesn't recognize the .Constraints and .Joints methods of component definition because I presume it only works in Assembly, not Part.

Would there be another solution to solve the body placements going haywire?

Anonymous · ‎10-15-2020

My code is only going to work in an Assembly.