VBA 在控制 SOLIDWORKS Pack and Go 功能时重命名文件

Question

我一直在胡思乱想，试图从 Excel VBA 中找出控制 SOLIDWORKS pack and Go 功能的代码。我已经想出了一个打包并转到特定位置的功能，但是我在弄清楚如何更改打包文件的文件名时遇到了麻烦。我有一个由 Excel 生成的“SaveName”字符串，我打算将其用作打包文件名。我到目前为止的代码：

Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim openFile As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim pgGetFileNames As Variant
Dim pgDocumentStatus As Variant
Dim status As Boolean
Dim warnings As Long
Dim errors As Long
Dim i As Long
Dim namesCount As Long
Dim myPath As String
Dim statuses As Variant

Dim partDocExt As SldWorks.ModelDocExtension

Sub PackAndGo()

Set swApp = GetObject(, "SldWorks.Application")
Set swModelDoc = swApp.OpenDoc("E:\FORMAT\FormatSketch.SLDPRT", swDocPART)
Set swModelDocExt = swModelDoc.Extension

'Open Part
openFile = "E:\FORMAT\FormatSketch.SLDPRT"

'Get Pack and Go object
Set swPackAndGo = swModelDocExt.GetPackAndGo

'Include any drawings
swPackAndGo.IncludeDrawings = True

'Set folder where to save the files
myPath = "E:\FORMAT\Temp\"
status = swPackAndGo.SetSaveToName(True, myPath)

'Flatten the Pack and Go folder structure; save all files to the root directory
swPackAndGo.FlattenToSingleFolder = True

'Pack and Go
statuses = swModelDocExt.SavePackAndGo(swPackAndGo)
        
End Sub

希望这里有人知道这个问题的答案并愿意分享答案

Answer 1

您需要像这样使用GetDocumentSaveToNames and SetDocumentSaveToNames：

Option Explicit
Sub PackAndGo()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim OpenFilePath As String
Dim OpenFileName As String
Dim SavePath As String
Dim SaveName As String
Dim myFileName As String
Dim myExtension As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim status As Boolean
Dim statuses As Variant
Dim i As Long

OpenFilePath = "E:\FORMAT\FormatSketch.SLDPRT"
SavePath = "E:\FORMAT\Temp\"
SaveName = "mySaveName"

Set swApp = Application.SldWorks
Set swModel = swApp.OpenDoc(OpenFilePath, swDocPART)
'Set swModel = swApp.ActiveDoc
OpenFilePath = swModel.GetPathName
OpenFileName = Mid(OpenFilePath, InStrRev(OpenFilePath, "\") + 1, InStrRev(OpenFilePath, ".") - InStrRev(OpenFilePath, "\") - 1)

Set swModelDocExt = swModel.Extension

'Get Pack and Go object
Set swPackAndGo = swModelDocExt.GetPackAndGo

'Include any drawings
swPackAndGo.IncludeDrawings = True

'Set folder where to save the files
status = swPackAndGo.SetSaveToName(True, SavePath)

'Get files path
status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus)
For i = 0 To UBound(pgFileNames)
    myFileName = Mid(pgFileNames(i), InStrRev(pgFileNames(i), "\") + 1, InStrRev(pgFileNames(i), ".") - InStrRev(pgFileNames(i), "\") - 1)
    myExtension = Right(pgFileNames(i), Len(pgFileNames(i)) - InStrRev(pgFileNames(i), ".") + 1)

    'Replace name
    If LCase(myFileName) = LCase(OpenFileName) Then
        pgFileNames(i) = SavePath & SaveName & myExtension
    End If
    Debug.Print "  Path is: " & pgFileNames(i)
Next

'Set files path
status = swPackAndGo.SetDocumentSaveToNames(pgFileNames)

'Flatten the Pack and Go folder structure; save all files to the root directory
swPackAndGo.FlattenToSingleFolder = True

'Pack and Go
statuses = swModelDocExt.SavePackAndGo(swPackAndGo)
        
End Sub

VBA 在控制 SOLIDWORKS Pack and Go 功能时重命名文件

VBA rename files while controlling SOLIDWORKS Pack and Go function

excel

vba

rename

solidworks