VBA macro to scale the geometry of the imported features using SOLIDWORKS API

{ width=250 }

This VBA macro scales all bodies form the imported features in active SOLIDWORKS part file. THe imported features will be generated if file is loaded from neutral formats like STEP, IGES, Parasolid unless 3D Interconnect option is used.

Set the scale factor in the SCALE_FACTOR constant.

Const SCALE_FACTOR As Double = 2.5

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Dim errs As Long
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        
        Dim swFeat As SldWorks.Feature
        
        Dim i As Integer
        i = -1
        
        Do
            i = i + 1
            Set swFeat = swModel.FeatureByPositionReverse(i)
            
            If swFeat.GetTypeName2() = "BaseBody" Then
                
                Dim swBody As SldWorks.Body2
                
                Set swBody = swFeat.GetFaces()(0).GetBody
                Set swBody = swBody.Copy
                
                ApplyScale swBody, SCALE_FACTOR
                
                swFeat.SetBody swBody
                
            End If
            
            If swFeat.GetTypeName2() = "OriginProfileFeature" Then
                Exit Do
            End If
            
        Loop While Not swFeat Is Nothing
        
    Else
        Err.Raise vbError, "", "Failed to load model: " & errs
    End If
    
End Sub

Sub ApplyScale(body As SldWorks.Body2, scaleFactor As Double)

    Dim dMatrix(15) As Double
    dMatrix(0) = 1: dMatrix(1) = 0: dMatrix(2) = 0: dMatrix(3) = 0
    dMatrix(4) = 1: dMatrix(5) = 0: dMatrix(6) = 0: dMatrix(7) = 0
    dMatrix(8) = 1: dMatrix(9) = 0: dMatrix(10) = 0: dMatrix(11) = 0
    dMatrix(12) = scaleFactor: dMatrix(13) = 0: dMatrix(14) = 0: dMatrix(15) = 0

    Dim swMathUtils As SldWorks.MathUtility
    Set swMathUtils = swApp.GetMathUtility
    
    Dim swMathTransform As SldWorks.MathTransform
    Set swMathTransform = swMathUtils.CreateTransform(dMatrix)

    body.ApplyTransform swMathTransform
    
End Sub