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