在一个solidworks程序中,其中没有打开任何文件,执行下面宏,将会打开一个零件图:

Option Explicit

Dim swApp As SldWorks.SldWorks

Sub main()

Set swApp = Application.SldWorks

Dim FileName As String
FileName = "D:\崔胜利\凯帝隆\湖北武穴锂宝\solidworks\e0301-P0321.SLDPRT"

Dim FileType As Integer
FileType = swDocumentTypes_e.swDocPART

Dim Options As Integer
Options = swOpenDocOptions_e.swOpenDocOptions_OpenDetailingMode

Dim Configuration As String
Configuration = ""

Dim e As Long
Dim w As Long

swApp.OpenDoc6 FileName, FileType, Options, Configuration, e, w

End Sub

api参考:

OpenDoc6

获取solidworks的活动文档,并且显示其文件名:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

Dim s As String

s = swModel.GetPathName

swApp.SendMsgToUser s

End Sub

api参考:

ModelDoc2

获取零件对象,并查看这个零件是否是焊件:

Option Explicit


Sub main()
  Dim swApp As SldWorks.SldWorks
  Dim swModel As SldWorks.ModelDoc2
  Dim swPart As SldWorks.PartDoc
  
  Set swApp = Application.SldWorks
  Set swModel = swApp.ActiveDoc
  Set swPart = swModel 'Explicit Type Cast

  ' Check to see if a part is loaded
  If swModel Is Nothing Then
    swApp.SendMsgToUser2 "Please open a part.", swMbStop, swMbOk
    Exit Sub
  End If
  
  Dim s As String
  s = swPart.IsWeldment
  swApp.SendMsgToUser s
    
End Sub

Get Material Example (VBA)
This example shows how to get the material for a part.

'------------------------------------------------------
' Preconditions:
' 1. Open a part with a configuration named Default.
' 2. Apply a material to the part.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Gets the name of the material applied to the part.
' 2. Examine the Immediate window.
'------------------------------------------------------
Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swPart As SldWorks.PartDoc
    Dim sMatName As String
    Dim sMatDB As String
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swPart = swModel
    sMatName = swPart.GetMaterialPropertyName2("Default", sMatDB)
    Debug.Print "File = " & swModel.GetPathName
    Debug.Print "  Material = " & sMatName & " (" & sMatDB & ")"
End Sub

说明sMatDB是输出参数。

修改零件的材质:

Option Explicit

Const sldmat As String = "C:/ProgramData/SolidWorks/SOLIDWORKS 2022/自定义材料/自定义材料.sldmat"


Sub main()
  Dim swApp As SldWorks.SldWorks
  Dim swModel As SldWorks.ModelDoc2
  Dim swPart As SldWorks.PartDoc
  
  Set swApp = Application.SldWorks
  Set swModel = swApp.ActiveDoc
  Set swPart = swModel 'Explicit Type Cast
  

swPart.SetMaterialPropertyName2 "默认<按加工>", sldmat, "PPH"
swPart.SetMaterialPropertyName2 "默认<按焊接>", sldmat, "PPH"

End Sub

This example shows how to iterate through all of the configurations in a document and forcibly rebuild each one.

'--------------------------------------------
' Preconditions:
' 1. Open a part or assembly.
' 2. Open the Immediate window.
'
' Postconditions:
' 1. Iterates through all configurations.
' 2. Examine the Immediate window.
'--------------------------------------------
Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim vConfNameArr As Variant
    Dim sConfigName As String
    'Dim nStart As Single
    Dim i As Long
    'Dim bShowConfig As Boolean
    'Dim bRet As Boolean
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Debug.Print "File = " + swModel.GetPathName

    vConfNameArr = swModel.GetConfigurationNames
    For i = 0 To UBound(vConfNameArr)
        sConfigName = vConfNameArr(i)
        'bShowConfig = swModel.ShowConfiguration2(sConfigName)
        'nStart = Timer
        'bRebuild = swModel.ForceRebuild3(False)
        Debug.Print "  Configuration = " & sConfigName
        'Debug.Print "    Configuration shown? " & bShowConfig
        'Debug.Print "    Configuration rebuilt? " & bRebuild
        'Debug.Print "    Execution time for this configuration = " & Timer - nStart & " seconds"
    Next i
End Sub

保存并关闭文件:

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 Errors As Long
    Dim Warnings As Long

    If swModel.Save3(swSaveAsOptions_Silent, Errors, Warnings) Then
        swApp.CloseDoc (swModel.GetPathName)
        Debug.Print "文件保存成功"
    Else
        Debug.Print "文件保存失败! " & Errors & Warnings
    End If
End Sub