solidworks修改零件材质

在solidworks没有打开任何文件的情况下，运行此宏。
此宏会打开指定的文件，修改其材质，保存并关闭文件。

Option Explicit

Sub main()
Dim filename As String
filename = "e0501-P0504"
Dim matname As String
matname = "PPH"
Call ChangeMaterialOfPart(filename, matname)
End Sub


Sub ChangeMaterialOfPart(filename As String, matname As String)

Const currentDir As String = "D:\崔胜利\凯帝隆\湖北武穴锂宝\solidworks\"
Const matlib As String = "C:/ProgramData/SolidWorks/SOLIDWORKS 2022/自定义材料/凯帝隆.sldmat"

Dim path As String
path = currentDir & filename & ".SLDPRT"

Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc

Set swApp = Application.SldWorks

Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

' Open
Set swPart = swApp.OpenDoc6(path, 1, 0, "", longstatus, longwarnings)

'todo:遍历配置
swPart.SetMaterialPropertyName2 "默认<按加工>", matlib, matname
swPart.SetMaterialPropertyName2 "默认<按焊接>", matlib, matname

' Save
Dim swErrors As Long
Dim swWarnings As Long
boolstatus = swPart.Save3(1, swErrors, swWarnings)

' Close Document
swApp.CloseDoc swPart.GetPathName

Set swPart = Nothing
Set swApp = Nothing

End Sub

Iterates through all configurations

solidworks已经打开了一个包含配置的文件，零件或装配体，运行此宏。
此宏会对当前文件，读取其所有的配置信息，并将其打印到立即窗口。

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    ' Debug.Print "File = " + swModel.GetPathName

    Dim vConfNameArr() As string '不指定数组大小，动态大小的string类型数组
    vConfNameArr = swModel.GetConfigurationNames

    Dim i As Long
    Dim sConfigName As String
    Dim bShowConfig As Boolean

    For i = 0 To UBound(vConfNameArr)
        sConfigName = vConfNameArr(i)
        bShowConfig = swModel.ShowConfiguration2(sConfigName)
        Debug.Print "Configuration = " & sConfigName
        Debug.Print "  Configuration shown? " & bShowConfig
    Next i
End Sub

修改材质改进

在solidworks没有打开任何文件的情况下，运行此宏。
此宏会打开指定的文件，修改其材质，保存文件，打印修改后的材质，并关闭文件。

Option Explicit

Sub main()
    Dim filename As String
    filename = "e0501-P0504"
    Dim matname As String
    matname = "PPH"
    Call ChangeMaterialOfPart(filename, matname)
End Sub


Sub ChangeMaterialOfPart(filename As String, matname As String)
    Const currentDir As String = "D:\崔胜利\凯帝隆\湖北武穴锂宝\solidworks\"
    Const matDB As String = "C:/ProgramData/SolidWorks/SOLIDWORKS 2022/自定义材料/凯帝隆.sldmat"

    Dim path As String
    path = currentDir & filename & ".SLDPRT"

    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks

    ' Open
    Dim swPart As SldWorks.PartDoc
    Dim longstatus As Long, longwarnings As Long
    Set swPart = swApp.OpenDoc6(path, 1, 0, "", longstatus, longwarnings)

    ' 修改所有配置的材质
    Dim vConfNameArr() As String
    vConfNameArr = swPart.GetConfigurationNames

    Dim i As Long
    Dim sConfigName As String

    For i = 0 To UBound(vConfNameArr)
        sConfigName = vConfNameArr(i)
        swPart.SetMaterialPropertyName2 sConfigName, matDB, matname
    Next i

    ' Save
    Dim boolstatus As Boolean
    Dim swErrors As Long
    Dim swWarnings As Long
    boolstatus = swPart.Save3(1, swErrors, swWarnings)

    '打印所有配置的材质
    Dim sMatName As String
    For i = 0 To UBound(vConfNameArr)
        sConfigName = vConfNameArr(i)
        sMatName = swPart.GetMaterialPropertyName2(sConfigName, matDB)
        Debug.Print "Material = " & sMatName & " (" & sConfigName & ")"
    Next i

    ' Close Document
    swApp.CloseDoc swPart.GetPathName
    
    Set swPart = Nothing
    Set swApp = Nothing

End Sub

如果你想刷新混乱不堪的立即窗口，将光标点进立即窗口，Ctrl+A全选窗口内的文本，然后按Delete，即可快速清除窗口。