Sub CATMain()
Dim ModelPath As String
Dim oDoc(1000) As Document
Dim odocs As Documents
Dim p As String
Dim x As String
Dim pc(1000) As ProductDocument
Dim pr(1000) As PartDocument
Dim y As String
Dim n As Long
Dim m As Double
'利用文件查找对话框获得新文件夹路径
ModelPath = ""
ModelPath = CATIA.FileSelectionBox("请选择文件夹", " * .CATProduct", CatFileSelectionModeSave)
If StrPtr(ModelPath) = 0 Then
MsgBox "取消操作!"
Exit Sub
End If
p = InStrRev(ModelPath, "\")
x = Left(ModelPath, p)
'获得CATIA文档集合
Set odocs = CATIA.Documents
UserForm2.Show vbmodelless
'应用CATIA文档集合数量,遍历特征树并保持各文档,沿着上述获得的路径
For i = 1 To odocs.Count
'利用泛型对象集合oDocs遍历CATIA当前文档
Set oDoc(i) = odocs.Item(i)
'Round(n / ProgressBar1.Max, 2) * 100 & "%"
'判断对象类型,产品型或者是零件型
If TypeName(oDoc(i)) = "ProductDocument" Then
'将泛型对象变成产品型对象
Set pc(i) = oDoc(i)
'保存文档
If i = 1 Then
CATIA.Application.DisplayFileAlerts = False 'True
odocs.Item(i).SaveAs x & pc(i).Product.PartNumber
ElseIf i > 1 Then
CATIA.Application.DisplayFileAlerts = False
odocs.Item(i).SaveAs x & pc(i).Product.PartNumber
End If
ElseIf TypeName(oDoc(i)) = "PartDocument" Then
Set pr(i) = oDoc(i)
'保存文档
If i = 1 Then
CATIA.Application.DisplayFileAlerts = True
odocs.Item(i).SaveAs x & pr(i).Product.PartNumber
ElseIf i > 1 Then
CATIA.Application.DisplayFileAlerts = False
odocs.Item(i).SaveAs x & pr(i).Product.PartNumber
End If
End If
Next i
'UserForm2.Show
End Sub