Private Sub Form_Load()
Dim objApp As SolidEdgeFramework.Application
Dim objDoc As SolidEdgePart.PartDocument
Dim objModel As SolidEdgePart.Model
' Dim objBottomCap As Face
' Dim objEdges As Edges
' Dim objEdgeArray(1 To 4) As Edge
' Dim objRound As SolidEdge.Round
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
Dim dblStartRadiusArray(1 To 4) As Double, dblEndRadiusArray(1 To 4) As Double
Dim i As Integer
' 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 : ' Attempt to get the physical properties on the model. This
' will only work if they've been computed previously.So first compute the
' physical properties on the base model and then attempt to get the physical properties
'***************
' 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 (dblVolume - 0.001 > TOLERANCE) Or (dblArea - 0.06 > TOLERANCE) Or _
(dblMass - 0.001 > TOLERANCE) Or (dblAccuracyOut - 0.0001 > TOLERANCE) Then
MsgBox ("ComputePhysicalProperties method of Model object fails")
End If
' Get the physical properties on the model.
Call objModel.GetPhysicalProperties( _
Status:=lngStatus, Density:=dblDensity, _
Accuracy:=dblAccuracyIn, Volume:=dblVolume, _
Area:=dblArea, Mass:=dblMass, CenterOfGravity:=dblCofGravity, _
CenterOfVolume:=dblCofVolume, _
GlobalMomentsOfInteria:=dblGlobalMoments, _
PrincipalMomentsOfInteria:=dblPrincipalMoments, _
PrincipalAxes:=dblPrincipalAxes, _
RadiiOfGyration:=dblRadiiOfGyration, _
RelativeAccuracyAchieved:=dblAccuracyOut)
' Checking the physical properties of model
' lngstatus value should be one. This indicates properties of the model is up to date.
If Abs(dblVolume - 0.001) > TOLERANCE Or Abs(dblArea - 0.06) > TOLERANCE Or _
Abs(dblMass - 0.001) > TOLERANCE Or Abs(dblAccuracyOut - 0.0001) > TOLERANCE Or _
(lngStatus <> 1) Then
MsgBox ("GetPhysicalProperties method of Model object fails")
End If
'****************
' CASE 2 : Change the base model. Without compute get the physical
' properties on the updated model
'****************
objModel.ExtrudedProtrusions(1).Depth = 0.15
'Get the physical properties on the updated model. _
Since the updated model has been not computed so _
GetPhysicalProperties returns the physical properties of the model
Call objModel.GetPhysicalProperties( _
Status:=lngStatus, Density:=dblDensity, _
Accuracy:=dblAccuracyIn, Volume:=dblVolume, _
Area:=dblArea, Mass:=dblMass, CenterOfGravity:=dblCofGravity, _
CenterOfVolume:=dblCofVolume, _
GlobalMomentsOfInteria:=dblGlobalMoments, _
PrincipalMomentsOfInteria:=dblPrincipalMoments, _
PrincipalAxes:=dblPrincipalAxes, _
RadiiOfGyration:=dblRadiiOfGyration, _
RelativeAccuracyAchieved:=dblAccuracyOut)
' lngstatus value should be zero. This indicates properties of the model to be out of date,
If (lngStatus <> 0) Then
MsgBox ("GetPhysicalProperties method of Model object fails for out-of-date values")
End If
' 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 ("GetPhysicalProperties method of Model object fails")
End If
' USER DISPLAY
' Release objects
Set objApp = Nothing
Set objDoc = Nothing
Set objModel = Nothing
End Sub