Option Explicit
Dim swApp As SldWorks.SldWorks 'SW應用程序
Dim swModel As ModelDoc2 'sw文檔
Dim sldmatFilePath As String 'SW材質數據文件路徑
Dim sldmatName As String 'SW材質名稱
Dim path As String 'sw文件路徑
Dim filename As String 'sw文件名
Dim boolstatus As Boolean '返回值 狀態
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "無活動文檔，請打開一個SolidWorks文件後重新運行此宏!", vbExclamation '消息框
Exit Sub '退出Main()
End If
sldmatFilePath = "c:/Program Files/SOLIDWORKS Corp/SOLIDWORKS/lang/chinese-simplified/sldmaterials/SOLIDWORKS materials.sldmat"
sldmatName = "普通碳鋼"
path = swModel.GetPathName 'Get the Path name + File Name
filename = Mid$(path, InStrRev(path, "\") + 1) ' File Name With extension
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitSystem, 0, swUnitSystem_e.swUnitSystem_Custom) '
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms) '
boolstatus = swModel.Extension.SelectByID2("未知", "BROWSERITEM", 0, 0, 0, False, 0, Nothing, 0)
swModel.ClearSelection2 True
swModel.SetMaterialPropertyName2 "默認", sldmatFilePath, sldmatName
swModel.ClearSelection2 True
swModel.Save '保存文件
End Sub