Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

CATIA Macro saving all elements of tree 1

Status
Not open for further replies.

elmundo777

Automotive
Jun 23, 2020
93
BY
Hello all
I'm faced with problem of saving parts/geometrical sets and other elements of the tree in product during using a macro.
If opened a product - macro saves only a product without other elements. I'm mean SaveAs() method.
Can anyone help me with ideas of macro that saves all elements of tree?
 
Replies continue below

Recommended for you

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


 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top