看完这个CATIA，你也能在1秒钟内给100个元素重命名

顾老总

对于某些有规范要求的设计，或者那些有强迫症的童鞋，给元素自动批量重命名是一件很爽的事！

　　比如，你的几何体本来在很有规律地按顺序命名，但你中间有个几何体不想要删掉了，再插入时，自动的序号并不会接着用它。给我们的感觉就是：即使删除了它，也抹不掉它曾经存在过的这个事实

　那么，如果我们能实现下面动图演示的效果，岂不美哉！


　　事实上，本篇文章今天要介绍的，就是如何用宏代码实现上面的功能。并且，这个代码非常简单！

　　首先，如果你连宏代码都不知道往哪写，或者写完不知道怎么运行，不知道怎么创建命令图标，不会查Automation手册等等，这些基础问题，请移步b站观看小编录制的《CATIAVBA/宏二次开发》的入门教学视频（扫描下面二维码即可观看）。

　　接下来，我们来看代码。其实原理就是遍历当前Part下的每个Body。然后有个序号，从1开始，每遍历一次序号都自加1。再把固定的前缀字符串与序号连接起来，就是我们最终要的命名了！

　　你去查Part下的自动化对象，它的子子孙孙一目了然，包括我们这次的目标Body。

因此，根据以上内容，我们不难写出以下代码：

　相信看到这里，各位小伙伴都已经跃跃欲试了吧！不过即使你的程序跑成功了，也不要得意忘形哦～学习讲究举一反三，所以请聪明的你们想一想，如何修改上面的程序，以实现下面动图演示的效果呢？

lhy123606

我用的这个：

Sub CATMain()
        Dim StrPrefix As String
        StrPrefix = InputBox("请输入要替换的几何体名称中的字符" & vbCrLf & vbCrLf & "Replace < / > and < . > and <Space> and < \ > to < _ > !", "几何体改名", "")
        'If StrPrefix = "" Then Exit Sub

        Dim EndPrefix As String
        EndPrefix = InputBox("请输入替换后的几何体名称中的字符" & vbCrLf & vbCrLf & "Replace < / > and < . > and <Space> and < \ > to < _ > !", "几何体改名", "")
        'If EndPrefix = "" Then Exit Sub

        Set RootPart = CATIA.ActiveDocument.Part
        Set oBodies = RootPart.Bodies

        For Each oBody In oBodies
                oBody.Name = Replace(Replace(Replace(Replace(Replace(oBody.Name, StrPrefix, EndPrefix), "/", "_"), ".", "_"), " ", "_"), "\", "_") 'Replace "/" and "."  and Space and "\" to "_"
        Next
        MsgBox "几何体名称替换完成", vbInformation
End Sub

ugandcatia

小狼的软件技巧很厉害啊   真的学习了

xiaoweijun_creo

谢谢楼主分享，楼主好人好梦！

UGS2019

好东西！

c31050201

手选法
Sub CATMain()
Dim Doc, Prt, SF, Slct, BodyO, BodyN
Set Doc = CATIA.ActiveDocument
Set Prt = Doc.Part
Set SF = Prt.ShapeFactory
Set Slct = Doc.Selection

Dim Status, lType(1)
lType(0) = "HybridBody"
lType(1) = "Body"

Status = Slct.SelectElement2(lType, "选择改名的目录", True)
If Status = "Redo" Or Status = "Undo" Or Status = "Cancel" Then
    Exit Sub
End If
Set iPart =Slct.Item(1).Value

Dim iBodies
Set iBodies = iPart.HybridBodies

Prefix = InputBox("请输入要替换的几何体名称中的字符" , , "XXX")
If Prefix = "" Then Exit Sub

Dim iBody, iCount
iCount = 1
For Each iBody In iBodies
iBody.Name = Prefix & "-" & iCount
iCount = iCount + 1
Next

End Sub



Dim iBodies

Set iBodies = iPart.HybridBodies

Prefix = InputBox("请输入要替换的几何体名称中的字符" , , "XXX")
If Prefix = "" Then Exit Sub

Dim iBody, iCount
iCount = 1
For Each iBody In iBodies
iBody.Name = Prefix & "-" & iCount
iCount = iCount + 1
Next
End Sub

wo5068056

感谢大佬！

Ngdoankete

谢谢分享