Attribute VB_Name = "mdlPhysischeEigenschaften"
Option Explicit

Sub subPhysikalischeEigenschaften()
    If objSeDocument.Type = igAssemblyDocument Then UpdatePhysPropAssembly
    If objSeDocument.Type = igPartDocument Then UpdatePhysPropPart
    If objSeDocument.Type = igSheetMetalDocument Then UpdatePhysPropPart
    If objSeDocument.Type = igWeldmentDocument Then UpdatePhysPropWeldment
End Sub
    
Sub UpdatePhysPropAssembly()
   'Physische Eigenschaften für Assambly
    objSeDocument.PhysicalProperties.Update
End Sub
   
Sub UpdatePhysPropPart()
   'Physische Eigenschaften für Part und SheetMetalPart
    Dim dblDensity As Double
    Dim dblAccuracyIn As Double
    Dim dblAccuracyOut As Double
    Dim dblVolume As Double
    Dim dblArea As Double
    Dim dblMass As Double
    Dim dblCofGravity() As Double
    Dim dblCofVolume() As Double
    Dim dblGlobalMoments() As Double
    Dim dblPrincipalMoments() As Double
    Dim dblPrincipalAxes() As Double
    Dim dblRadiiOfGyration() As Double
    Dim lngStatus As Long
   
   'Prüfen ob Benutzerdefinierte physische Eigenschaften gesetzt
    On Error Resume Next
    Call objSeDocument.GetUserPhysicalProperties( _
                Volume:=dblVolume, _
                Area:=dblArea, _
                Mass:=dblMass, _
                CenterOfGravity:=dblCofGravity, _
                CenterOfVolume:=dblCofVolume, _
                GlobalMomentsOfInertia:=dblGlobalMoments, _
                PrincipalMomentsOfInertia:=dblPrincipalMoments, _
                PrincipalAxes:=dblPrincipalAxes, _
                RadiiOfGyration:=dblRadiiOfGyration)
    If Err.Number = 0 Then Exit Sub
    On Error GoTo 0
    
   'Physische Eigenschaften neu berechnen
    dblDensity = fncMaterial("SpezGew")
    dblAccuracyIn = 1
    Call objSeDocument.Models(1).ComputePhysicalProperties( _
                Density:=dblDensity, _
                Accuracy:=dblAccuracyIn, _
                Volume:=dblVolume, _
                Area:=dblArea, _
                Mass:=dblMass, _
                CenterOfGravity:=dblCofGravity, _
                CenterOfVolume:=dblCofVolume, _
                GlobalMomentsOfInteria:=dblGlobalMoments, _
                PrincipalMomentsOfInteria:=dblPrincipalMoments, _
                PrincipalAxes:=dblPrincipalAxes, _
                RadiiOfGyration:=dblRadiiOfGyration, _
                RelativeAccuracyAchieved:=dblAccuracyOut, _
                Status:=lngStatus)
End Sub
Sub UpdatePhysPropWeldment()
   'Physische Eigenschaften für Weldment
    Dim dblDensity As Double
    Dim dblAccuracyIn As Double
    Dim dblAccuracyOut As Double
    Dim dblBeadDensity As Double
    Dim dblCoordinateSystem As Double
    Dim dblVolume As Double
    Dim dblArea As Double
    Dim dblMass As Double
    Dim dblCofGravity() As Double
    Dim dblCofVolume() As Double
    Dim dblGlobalMoments() As Double
    Dim dblPrincipalMoments() As Double
    Dim dblPrincipalAxes() As Double
    Dim dblRadiiOfGyration() As Double
    Dim lngStatus As Long
   
   'Prüfen ob Benutzerdefinierte physische Eigenschaften gesetzt
    On Error Resume Next
    Call objSeDocument.GetUserPhysicalProperties( _
                Volume:=dblVolume, _
                Area:=dblArea, _
                Mass:=dblMass, _
                CenterOfGravity:=dblCofGravity, _
                CenterOfVolume:=dblCofVolume, _
                GlobalMomentsOfInertia:=dblGlobalMoments, _
                PrincipalMomentsOfInertia:=dblPrincipalMoments, _
                PrincipalAxes:=dblPrincipalAxes, _
                RadiiOfGyration:=dblRadiiOfGyration)
    If Err.Number = 0 Then Exit Sub
    On Error GoTo 0
    
   'Physische Eigenschaften neu berechnen
    dblDensity = fncMaterial("SpezGew")
    dblBeadDensity = dblDensity
    dblAccuracyIn = 1
    Call objSeDocument.WeldmentModels(1).ComputePhysicalProperties( _
                Density:=dblDensity, _
                Accuracy:=dblAccuracyIn, _
                BeadDensity:=dblBeadDensity, _
                Volume:=dblVolume, _
                Area:=dblArea, _
                Mass:=dblMass, _
                CenterOfGravity:=dblCofGravity, _
                CenterOfVolume:=dblCofVolume, _
                GlobalMomentsOfInteria:=dblGlobalMoments, _
                PrincipalMomentsOfInteria:=dblPrincipalMoments, _
                PrincipalAxes:=dblPrincipalAxes, _
                RadiiOfGyration:=dblRadiiOfGyration, _
                RelativeAccuracyAchieved:=dblAccuracyOut, _
                Status:=lngStatus)
End Sub