' -----------------------------------------------------------

'批量重命名后批量保存

'程序說明：

'程序?qū)崿F(xiàn)在Product下，對第一層結(jié)構(gòu)樹內(nèi)零件批量重命名，

'并將重命名后的零件以新零件名保存在當前路徑下。

'程序運行前應(yīng)先手動將不需要重命名的零部件隱藏(如外購件等)。

' -----------------------------------------------------------

Sub CATMain()

On Error Resume Next

Set rootDoc = CATIA.ActiveDocument

On Error GoTo 0

If TypeName(rootDoc) <> "ProductDocument" Then

MsgBox "錯誤！" & vbLf & _

"本程序僅能在Product下運行！" & vbLf & vbLf & _

"程序?qū)⒈魂P(guān)閉！", vbOKOnly + vbCritical, " "

Exit Sub

End If

MsgBox "注意！" & vbLf & _

"運行前請先隱藏外購件！" & vbLf & vbLf & _

"??", vbOKOnly + vbInformation, " "

Set productDocument1 = CATIA.ActiveDocument

Set selection = productDocument1.Selection

Set visPropertySet = selection.VisProperties

Set product1 = productDocument1.Product

Set products1 = product1.Products

DocPath = productDocument1.Path '獲取當前文檔保存路徑

' -----------------------------------------------------------

'初始化

' -----------------------------------------------------------

strName = Inputbox("輸入組件名","請輸入組件名","")

If strName=False Then '取消命名則退出程序

Exit Sub

End If

j=0

k=0

' -----------------------------------------------------------

'尋找相同的part，并隱藏

' -----------------------------------------------------------

For m=1 to products1.Count-1

For n=m+1??to products1.Count

str1 = products1.Item(m).PartNumber

str2 = products1.Item(n).PartNumber

if (Instr(str1,str2)) Then

Set producti = products1.Item(n)

Set products1 = producti.Parent

selection.Add producti

Set visPropertySet = visPropertySet.Parent

visPropertySet.SetShow 1

selection.Clear

end if

Next

Next

' -----------------------------------------------------------

'重命名

' -----------------------------------------------------------

For i=1 to products1.Count

Set producti = products1.Item(i)

Set products1 = producti.Parent

selection.Add producti

Set visPropertySet = visPropertySet.Parent

visPropertySet.GetShow showstate

selection.Clear

If??showstate <> 1 Then??'隱藏為1

If not(Instr(products1.Item(i).PartNumber,strName)) Then

j=j+1

str = CStr(int(j))

if j<10 then

str = "0" & str??'零件號尾部

end if

if 10

str = "0" & str??'零件號尾部

end if

products1.Item(i).PartNumber= strName & "-" & str? ?? ?'批量修改零件號

strPartNumber = products1.Item(i).PartNumber

products1.Item(i).name = strPartNumber & "." & 1

SaveToFile products1.Item(i), DocPath '保存重命名的文件

end if

end if

Next

' -----------------------------------------------------------

'尋找相同的part，并編號

' -----------------------------------------------------------

k2=1

For m=1 to products1.Count-1

Set producti = products1.Item(m)

Set products1 = producti.Parent

selection.Add producti

Set visPropertySet = visPropertySet.Parent

visPropertySet.GetShow showstate

selection.Clear

If showstate <> 1 Then

For n=m+1??to products1.Count

str1 = products1.Item(m).PartNumber

str2 = products1.Item(n).PartNumber

If (Instr(str1,str2)) Then

k2=k2+1

products1.Item(n).name = str2??& "." & k2

End if

Next

k2=1

End if

Next

Msgbox "文件已保存至該路徑--->" & DocPath

End Sub

' -----------------------------------------------------------

' 文件保存路徑

' -----------------------------------------------------------

Sub SaveToFile(oProduct, DocPath)

'loop inside the product

Dim i 'As Integer

Dim intIncrement 'As Integer

On Error Resume Next

oProduct.ReferenceProduct.Parent.SaveAs DocPath & "\" & oProduct.PartNumber

On Error GoTo 0

For i = 1 To oProduct.Products.Count

Set prdSubProduct = oProduct.Products.Item(i)

If prdSubProduct.HasAMasterShapeRepresentation() Then

Set prdRefProduct = prdSubProduct.ReferenceProduct

Set docSubDocument = prdRefProduct.Parent

strSubFullPath = docSubDocument.FullName

'identification of the component (CATPart or CATProduct)

Dim extension 'As String

If InStr(strSubFullPath, ".CATPart") Then

extension = ".CATPart"

Else

extension = ".CATProduct"

End If

docSubDocument.SaveAs DocPath & "\" & prdRefProduct.Name & extension

CATIA.DisplayFileAlerts = False

Else

Dim oSubSubProds 'As Products

Set oSubSubProds = prdSubProduct.Products

If oSubSubProds.Count > 0 Then

Call SaveToFile(prdSubProduct, DocPath)

End If

End If

Next

strSubFullPath =""

prdSubProduct =""

prdRefProduct =""

docSubDocument =""

oSubSubProds =""

folderpath =""

End Sub

總結(jié)

以上是生活随笔為你收集整理的catia利用宏批量改名的方法_谁有CATIA批量改名的宏程序啊的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。