关于Solidworks 二次开发中打包问题 - iCAx开思网

Dim Swapp As SldWorks.SldWorks
Dim Prat As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim namesCount As Integer
Dim status As Boolean
Dim pgFileNames As Object = Nothing
Dim Kei As String
Dim myPath As String
Dim Qianz As Boolean
Dim Hoz As Boolean
'Dim pgGetFileNames As Object
'Dim pgDocumentStatus As Object
Dim statuses As Object
Dim i As Integer
Dim tempArray As String
'Dim Dabao() As String
Dim pgFileStatus As Object = Nothing
tempArray = RichTextBox1.Text
Swapp = CreateObject("Sldworks.application")
Prat = Swapp.ActiveDoc
swModelDocExt = Prat.Extension
'准备打包
'Debug.Print("Pack and Go")
swPackAndGo = swModelDocExt.GetPackAndGo
'获得获取装配中的文档数量
namesCount = swPackAndGo.GetDocumentNamesCount
Debug.Print(" Number of model documents: " & namesCount)
'是否打包工程图
swPackAndGo.IncludeDrawings = RadioButton1.Checked
Debug.Print(" Include drawings: " & swPackAndGo.IncludeDrawings)
Debug.Print（RadioButton1.Checked）
''是否打包标准件
'swPackAndGo.IncludeToolboxComponents = RadioButton3.Checked
'Debug.Print（RadioButton3.Checked）
'获取打开模型路径和文件名
status = swPackAndGo.GetDocumentNames(pgFileNames)
If Not pgFileNames Is Nothing Then
For i = 0 To UBound(pgFileNames)
pgFileNames(i) = pgFileNames(i).Toupper()
Kei = pgFileNames（i）
RichTextBox1.Text &= Kei & vbNewLine
Debug.Print(Kei)
Next i
End If
'设置保存模型的文件夹
myPath = TextBox1.Text
status = swPackAndGo.SetSaveToName(True, myPath)
'获取用于打包的模型文档路径和名称
status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, 0)
If Not pgFileNames Is Nothing Then
For i = 0 To UBound(pgFileNames)
pgFileNames(i) = pgFileNames(i).Toupper()
Next i
End If
'设置更改打包的文档的路径和文件名
Dim FavetoNames As Boolean
FavetoNames = swPackAndGo.SetDocumentSaveToNames(pgFileNames)
'向文件名添加前辍和后辍
Qianz = CheckBox1.Checked
Hoz = CheckBox2.Checked
If Qianz = True Then
swPackAndGo.AddPrefix = TextBox3.Text
ElseIf Hoz = True Then
swPackAndGo.AddSuffix = TextBox4.Text
End If
''如果向文件名添加前辍和后辍，则验证文件名和文件路径
'ReDim pgGetFileNames(namesCount - 1)
'ReDim pgDocumentStatus(namesCount - 1)
'status = swPackAndGo.GetDocumentSaveToNames(pgGetFileNames, pgDocumentStatus)
'For i = 0 To (namesCount - 1)
' Debug.Print(" My path and filename is: " & pgGetFileNames(i))
'Next i
'平展到单一文件夹，将所有文件保存到根目录
swPackAndGo.FlattenToSingleFolder = True
'打包
statuses = swModelDocExt.SavePackAndGo(swPackAndGo)

复制代码