谁有CATIA批量改名的宏程序啊

谁有CATIA批量改名的宏程序啊？

' -----------------------------------------------------------
'批量重命名后批量保存
'程序说明：
'程序实现在Product下，对第一层结构树内零件批量重命名，
'并将重命名后的零件以新零件名保存在当前路径下。
'程序运行前应先手动将不需要重命名的零部件隐藏（如外购件等）。
' -----------------------------------------------------------

Sub CATMain()

        On Error Resume Next
        Set rootDoc = CATIA.ActiveDocument
        On Error GoTo 0
   
        If TypeName(rootDoc) <> "ProductDocument" Then
                MsgBox "错误！" & vbLf & _
                        "本程序仅能在Product下运行！" & vbLf & vbLf & _
                        "程序将被关闭！", 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<j<=100 then
                        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

有否替换字符串 批量改名方法？

这个好像是重新命名宏，没法替换其中摸一个字符

正好是我需要的