Option Explicit
Dim swApp As Object
Dim Part As Object
Dim MassProp As MassProperty
Dim MassCenter(2) As Double
Dim RefPlaneFeature As Object
Dim SketchMgr As Object
Dim SketchPoint As Object
Sub main()
' SolidWorksアプリケーションへの接続
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If Part Is Nothing Then
MsgBox "モデルが開いていません"
Exit Sub
End If
' 質量プロパティオブジェクトを取得
Set MassProp = Part.Extension.CreateMassProperty
If MassProp Is Nothing Then
MsgBox "質量プロパティを取得できませんでした。"
Exit Sub
End If
' 重心の位置を取得
MassCenter(0) = MassProp.CenterOfMass(0) ' X座標
MassCenter(1) = MassProp.CenterOfMass(1) ' Y座標
MassCenter(2) = MassProp.CenterOfMass(2) ' Z座標
'正面を選択
Dim boolstatus As Boolean
boolstatus = Part.Extension.SelectByID2("正面", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
' 平面を挿入
Set RefPlaneFeature = Part.FeatureManager.InsertRefPlane(swRefPlaneReferenceConstraint_Distance, MassCenter(2), 0, 0, 0, 0)
If RefPlaneFeature Is Nothing Then
MsgBox "参照平面の作成に失敗しました。"
Exit Sub
End If
' スケッチマネージャーを取得
Set SketchMgr = Part.SketchManager
' 作成した参照平面を選択
RefPlaneFeature.Select False
' 新しいスケッチを開始
SketchMgr.InsertSketch True
' 重心の位置に点を作成
Set SketchPoint = SketchMgr.CreatePoint(MassCenter(0), MassCenter(1), MassCenter(2))
' スケッチを閉じる
SketchMgr.InsertSketch True
MsgBox "重心の位置を通過する参照ジオメトリ平面上に点がスケッチされました。"
End Sub