Момент инерции плоского сечения

Public Sub PutSketchToCentroid()
    On Error Resume Next
    If Not TypeOf ThisApplication.ActiveEditObject Is Sketch Then
        MsgBox "Должен редактироваться эскиз!"
        Exit Sub
    End If
    Dim oSketch As Sketch
    Set oSketch = ThisApplication.ActiveEditObject
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid
    Dim oRegionProps As RegionProperties
    Set oRegionProps = oProfile.RegionProperties
    oRegionProps.Accuracy = kMedium
    Dim oVec As Vector2d
    Set oVec = ThisApplication.TransientGeometry.CreateVector2d(0 - oRegionProps.Centroid.X, 0 - oRegionProps.Centroid.y)
    Dim oSketchObjects As ObjectCollection
    Set oSketchObjects = ThisApplication.TransientObjects.CreateObjectCollection
    Dim oSketchEntity As SketchEntity
    For Each oSketchEntity In oSketch.SketchEntities
        oSketchObjects.Add oSketchEntity
    Next
    Call oSketch.MoveSketchObjects(oSketchObjects, oVec)
    
    'Совмещение главных осей с осями эскизи поворотом элементов вокруг оси Z
    Dim oPt As Point2d
    Set oPt = ThisApplication.TransientGeometry.CreatePoint2d(0#, 0#)
    Dim oAng As Double
    If Abs(oRegionProps.RotationAngle) > 0.000001 Then
        If MsgBox("Совместить главные оси с осями эскиза?", vbOKCancel, "Совмещение осей") = vbOK Then
            oAng = oRegionProps.RotationAngle / 180 * Atn(1) * 4
            Call oSketch.RotateSketchObjects(oSketchObjects, oPt, 0 - oAng)
        End If
    End If
    'Поворот эскиза на 90°
    If MsgBox("Повернуть эскиз на 90°?", vbOKCancel, "Поворот эскиза") = vbOK Then
        oAng = Atn(1) * 2
        Call oSketch.RotateSketchObjects(oSketchObjects, oPt, oAng)
    End If
    
    'Параметры
    Set oProfile = oSketch.Profiles.AddForSolid
    Set oRegionProps = oProfile.RegionProperties
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oPar As Parameter
    
    'Моменты инерции относительно главных осей
    Dim adPrincipalMoments(1 To 3) As Double
    Call oRegionProps.PrincipalMomentsOfInertia(adPrincipalMoments(1), adPrincipalMoments(2), adPrincipalMoments(3))
    
    Set oPar = oDoc.ComponentDefinition.Parameters("Ix")
    If oPar Is Nothing Then
        Set oPar = oDoc.ComponentDefinition.Parameters.UserParameters.AddByEx * pression("Ix", Str(adPrincipalMoments(1)) & " cm^4", "cm^4")
    Else
        If oPar.Value <> adPrincipalMoments(1) Then
            oPar.Value = adPrincipalMoments(1)
        End If
    End If
    
    Set oPar = Nothing
    Set oPar = oDoc.ComponentDefinition.Parameters("Iy")
    If oPar Is Nothing Then
        Set oPar = oDoc.ComponentDefinition.Parameters.UserParameters.AddByEx * pression("Iy", Str(adPrincipalMoments(2)) & " cm^4", "cm^4")
    Else
        If oPar.Value <> adPrincipalMoments(2) Then
            oPar.Value = adPrincipalMoments(2)
        End If
    End If
    
    'Моменты инерции относительно осей эскиза
    Dim Ixx As Double, Iyy As Double, Izz As Double
    Dim Ixy As Double, Iyz As Double, Ixz As Double
    Call oRegionProps.MomentsOfInertia(Ixx, Iyy, Izz, Ixy, Iyz, Ixz)
    
    Set oPar = Nothing
    Set oPar = oDoc.ComponentDefinition.Parameters("Ixx")
    If oPar Is Nothing Then
        Set oPar = oDoc.ComponentDefinition.Parameters.UserParameters.AddByEx * pression("Ixx", Str(Ixx) & " cm^4", "cm^4")
    Else
        If oPar.Value <> Ixx Then
            oPar.Value = Ixx
        End If
    End If
    
    Set oPar = Nothing
    Set oPar = oDoc.ComponentDefinition.Parameters("Iyy")
    If oPar Is Nothing Then
        Set oPar = oDoc.ComponentDefinition.Parameters.UserParameters.AddByEx * pression("Iyy", Str(Iyy) & " cm^4", "cm^4")
    Else
        If oPar.Value <> Iyy Then
            oPar.Value = Iyy
        End If
    End If
    
    'Моменты соротивления относительно осей эскиза
    Dim Xmax As Double, Ymax As Double
    Xmax = 0#: Ymax = 0#
    Dim MaxPoint As Point2d, MinPoint As Point2d
    Dim oProfEntity As ProfileEntity
    For Each oProfEntity In oProfile.Item(1)
        Dim oBox As Box2d
        Set oBox = oProfEntity.SketchEntity.RangeBox
        If Not oBox Is Nothing Then
            Set MaxPoint = oBox.MaxPoint
            Set MinPoint = oBox.MinPoint
            If Abs(MaxPoint.X) >= Abs(MinPoint.X) Then
                If Abs(MaxPoint.X) > Abs(Ymax) Then
                    Ymax = MaxPoint.X
                End If
            Else
                If Abs(MinPoint.X) > Abs(Ymax) Then
                    Ymax = MinPoint.X
                End If
            End If
            If Abs(MaxPoint.y) >= Abs(MinPoint.y) Then
                If Abs(MaxPoint.y) > Abs(Xmax) Then
                    Xmax = MaxPoint.y
                End If
            Else
                If Abs(MinPoint.y) > Abs(Xmax) Then
                    Xmax = MinPoint.y
                End If
            End If
        End If
    Next
    
    Xmax = Abs(Xmax): Ymax = Abs(Ymax)
    Set oPar = Nothing
    Set oPar = oDoc.ComponentDefinition.Parameters("Wx")
    
    If oPar Is Nothing Then
        Set oPar = oDoc.ComponentDefinition.Parameters.UserParameters.AddByEx * pression("Wx", Str(Ixx / Xmax) & " cm^3", "cm^3")
    Else
        If oPar.Value <> Ixx / Xmax Then
            oPar.Value = Ixx / Xmax
        End If
    End If
    
    Set oPar = Nothing
    Set oPar = oDoc.ComponentDefinition.Parameters("Wy")
    If oPar Is Nothing Then
        Set oPar = oDoc.ComponentDefinition.Parameters.UserParameters.AddByEx * pression("Wy", Str(Iyy / Ymax) & " cm^3", "cm^3")
    Else
        If oPar.Value <> Iyy / Ymax Then
            oPar.Value = Iyy / Ymax
        End If
    End If
End Sub