控制SOLIDWORKS包和Go函数时VBA重命名文件
控制SOLIDWORKS包和Go函数时VBA重命名文件
提问于 2021-06-19 20:15:06
我一直在乱搞，试图找出控制SOLIDWORKS包和Excel中的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希望在座的人知道这个问题的答案，并愿意分享答案。
回答 1
Stack Overflow用户
回答已采纳
发布于 2021-06-20 05:23:51
您需要像这样使用GetDocumentSaveToNames和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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/68050412
复制相关文章
相似问题
腾讯云开发者
