Private Sub Form_Load()
Dim objApp As SolidEdgeFrameWork.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objModel As SolidEdgePart.Model
Dim objProfile As SolidEdgePart.Profile
Const TESTFILE = "T:\vbtests\testcases\cube.par"
Const TOLERANCE = 0.0001
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
' Report errors
Const PI = 3.14159265358979
' Create/get the application with specific settings
On Error Resume Next
Set objApp = GetObject(, "SolidEdge.Application")
If Err Then
Err.Clear
Set objApp = CreateObject("SolidEdge.Application")
Set objDoc = objApp.Documents.Add("SolidEdge.PartDocument")
objApp.Visible = True
Else
Set objDoc = objApp.ActiveDocument
End If
' Close the part document
Call objDoc.Close
' Open a Testcase
Set objDoc = objApp.Documents.Open(Filename:=TESTFILE)
' Get the model object in the test case
Set objModel = objDoc.Models(1)
'************************
' CASE 1 : Compute the Physical Properties on base model
'************************
' Compute the physical properties on the model.
dblDensity = 1
dblAccuracyIn = 0.0001
Call objModel.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)
' Checking the physical properties of model
If Abs(dblVolume - 0.001) > TOLERANCE Or Abs(dblArea - 0.06) > TOLERANCE Or _
Abs(dblMass - 0.001) > TOLERANCE Or Abs(dblAccuracyOut - 0.0001) > TOLERANCE Then
MsgBox ("ComputePhysicalProperties method of Model object fails")
End If
'***********************************
' CASE 2 : Compute the Physical Properties on updated model
'***********************************
'Compute the the physical properties on the updated model. _
Since the updated model has been not computed so _
ComputePhysicalProperties should recompute and then return the _
physical properties of the updated model.
objModel.ExtrudedProtrusions(1).Depth = 0.125
' Compute the physical properties on the updated model.
dblDensity = 1
dblAccuracyIn = 0.0001
Call objModel.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)
' Checking the physical properties of updated model
If Abs(dblVolume - 0.00125) > TOLERANCE Or Abs(dblArea - 0.07) > TOLERANCE Or _
Abs(dblMass - 0.00125) > TOLERANCE Or Abs(dblAccuracyOut - 0.0001) > TOLERANCE Then
MsgBox ("ComputePhysicalProperties method of Model object fails")
End If
'***********************************
' CASE 3 : Compute the Physical Properties on Failed model
'***********************************
' Create a failed feature and Compute physical properties on Failed model
Set objProfile = objDoc.ProfileSets.Add.Profiles.Add(objDoc.RefPlanes(1))
Call objProfile.Circles2d.AddByCenterRadius(0.015, 0.015, 0.005)
Call objProfile.End(igProfileClosed)
Call objModel.ExtrudedProtrusions.AddFinite(objProfile, igLeft, igLeft, 0.015)
If objModel.ExtrudedProtrusions(2).Status <> igFeatureFailed Then
MsgBox "Failed to create a sick feature"
End If
objProfile.Visible = False
' Compute the physical properties on the failed model.
dblDensity = 1
dblAccuracyIn = 0.0001
Call objModel.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)
' USER DISPLAY
' Release objects
Dim i As Integer
Set objApp = Nothing
Set objDoc = Nothing
Set objModel = Nothing
Set objProfile = Nothing
End Sub