AutoCAD 2006 VBA程序参考之----实体分析:质量特性。

兰州人

Analyzing Solids: Mass Properties---实体分析------质量特性
Each 3DSolid object has a number of mass properties you can use for analysis. These properties
include the center of gravity, the total volume of the solid, the radii of gyration, the product of
inertia, and the moment of inertia.
每个3维实体你可以分析三维实体的质量特性，包括质量中心，实体的全容积，回转半径，惯性积，惯性力矩。
The following example displays the mass properties for a selected solid. Try it on one of
the solids you created earlier in the chapter.
这个实例表述选择实体质量特性。

2. Public Sub TestMassProperties()
3.   Dim objEnt As Acad3DSolid
4.   Dim varPick As Variant
5.   Dim strMassProperties As String
6.   Dim varProperty As Variant
7.   Dim intI As Integer
8.   On Error Resume Next
9.   '' let user pick a solid
10.   With ThisDrawing.Utility
11.     .GetEntity objEnt, varPick, vbCr & "Pick a solid: "
12.     If Err Then
13.       MsgBox "That is not an Acad3DSolid"
14.       Exit Sub
15.     End If
16.   End With
17.   '' format mass properties
18.   With objEnt
19.     strMassProperties = "Volume: "
20.     strMassProperties = strMassProperties & vbCr & " " & .Volume
21.     strMassProperties = strMassProperties & vbCr & vbCr & _
22.     "Center Of Gravity: "
23.     For Each varProperty In .Centroid
24.       strMassProperties = strMassProperties & vbCr & " " & varProperty
25.     Next
26.     strMassProperties = strMassProperties & vbCr & vbCr & _
27.       "Moment Of Inertia: "
28.     For Each varProperty In .MomentOfInertia
29.       strMassProperties = strMassProperties & vbCr & " " & varProperty
30.     Next
31.     strMassProperties = strMassProperties & vbCr & vbCr & _
32.       "Product Of Inertia: "
33.     For Each varProperty In .ProductOfInertia
34.       strMassProperties = strMassProperties & vbCr & " " & varProperty
35.     Next
36.     strMassProperties = strMassProperties & vbCr & vbCr & "Principal Moments: "
37.     For Each varProperty In .PrincipalMoments
38.       strMassProperties = strMassProperties & vbCr & " " & varProperty
39.     Next
40.     strMassProperties = strMassProperties & vbCr & vbCr & "Radii Of Gyration: "
41.     For Each varProperty In .RadiiOfGyration
42.       strMassProperties = strMassProperties & vbCr & " " & varProperty
43.     Next
44.     strMassProperties = strMassProperties & vbCr & vbCr & "Principal Directions: "
45.     For intI = 0 To UBound(.PrincipalDirections) / 3
46.       strMassProperties = strMassProperties & vbCr & " (" & _
47.         .PrincipalDirections((intI - 1) * 3) & ", " & _
48.         .PrincipalDirections((intI - 1) * 3 + 1) & "," & _
49.         .PrincipalDirections((intI - 1) * 3 + 2) & ")"
50.     Next
51.   End With
52.   '' highlight entity
53.   objEnt.Highlight True
54.   objEnt.Update
55.   '' display properties
56.   MsgBox strMassProperties, , "Mass Properties"
57.   '' dehighlight entity
58.   objEnt.Highlight False
59.   objEnt.Update
60. End Sub

Public Sub TestMassProperties()   Dim objEnt As Acad3DSolid   Dim varPick As Variant   Dim strMassProperties As String   Dim varProperty As Variant   Dim intI As Integer   On Error Resume Next   '' let user pick a solid   With ThisDrawing.Utility     .GetEntity objEnt, varPick, vbCr & "Pick a solid: "     If Err Then       MsgBox "That is not an Acad3DSolid"       Exit Sub     End If   End With   '' format mass properties   With objEnt     strMassProperties = "Volume: "     strMassProperties = strMassProperties & vbCr & " " & .Volume     strMassProperties = strMassProperties & vbCr & vbCr & _     "Center Of Gravity: "     For Each varProperty In .Centroid       strMassProperties = strMassProperties & vbCr & " " & varProperty     Next     strMassProperties = strMassProperties & vbCr & vbCr & _       "Moment Of Inertia: "     For Each varProperty In .MomentOfInertia       strMassProperties = strMassProperties & vbCr & " " & varProperty     Next     strMassProperties = strMassProperties & vbCr & vbCr & _       "Product Of Inertia: "     For Each varProperty In .ProductOfInertia       strMassProperties = strMassProperties & vbCr & " " & varProperty     Next     strMassProperties = strMassProperties & vbCr & vbCr & "Principal Moments: "     For Each varProperty In .PrincipalMoments       strMassProperties = strMassProperties & vbCr & " " & varProperty     Next     strMassProperties = strMassProperties & vbCr & vbCr & "Radii Of Gyration: "     For Each varProperty In .RadiiOfGyration       strMassProperties = strMassProperties & vbCr & " " & varProperty     Next     strMassProperties = strMassProperties & vbCr & vbCr & "Principal Directions: "     For intI = 0 To UBound(.PrincipalDirections) / 3       strMassProperties = strMassProperties & vbCr & " (" & _         .PrincipalDirections((intI - 1) * 3) & ", " & _         .PrincipalDirections((intI - 1) * 3 + 1) & "," & _         .PrincipalDirections((intI - 1) * 3 + 2) & ")"     Next   End With   '' highlight entity   objEnt.Highlight True   objEnt.Update   '' display properties   MsgBox strMassProperties, , "Mass Properties"   '' dehighlight entity   objEnt.Highlight False   objEnt.Update End Sub