SW二次开发-在装配体中自动遍历重命名

搞机械的假程序猿

已于 2024-02-05 08:41:56 修改

阅读量1.4k

点赞数 14

分类专栏： sw二次开发文章标签： SW二次开发宏插件

于 2023-12-02 18:29:03 首次发布

本文链接：https://blog.csdn.net/ssismm/article/details/134754643

版权

sw二次开发专栏收录该内容

1 篇文章 0 订阅

订阅专栏

前言

本人机械设计一枚，从业十年有余，一直使用SW绘图，算是小有心得；通过定制模板和自定义属性，可以提高工作效率；但是一直有个问题没有解决！

在设计阶段，新建零件的命名是随意的；但是在出图阶段，一般公司都会要求，以“图号+名称”作为文件的存档名称；于是，无数的、悲催的机械设计工程师们，为了迎合这一野蛮的要求，只能在装配体目录树中，逐个手动改写。。。

只要思想不滑坡，办法永远比困难多！通过借鉴同行的处理办法，试着编写了一些宏插件，读取零件的自定义属性里面的图号和名称，可以实现“一键重命名”，但效率依然不是很理想。。。

最近恰好有时间，就仔细研究了一下这个问题，自我感觉算是找到了终极秘钥！还是通过编写宏插件的方式，在装配体中，逐个遍历零部件，自动读取零件的自定义属性，实现批量重命名！

同时，针对公司的文件命名规则，对加工件、标准件、外购件的命名，加以区分。

亲测可用，在此做个记录。

装配体自定义属性

加工件自定义属性

标准件自定义属性

外购件自定义属性

宏按钮

宏文件

宏代码如下

VB水平有限，代码写的有点冗长，但可用^_^

' ******************************************************************************
' 批量重命名 单大伟 2023.12.1
' ******************************************************************************
Dim swApp As Object

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long


Sub main()

' 连接SW
Set swApp = Application.SldWorks

' 设为当前
Set Part = swApp.ActiveDoc




'判断文件类型

ASM_Name1 = Left(swApp.ActiveDoc.GetPathName, InStrRev(swApp.ActiveDoc.GetPathName, "."))
ASM_Name2 = Right(swApp.ActiveDoc.GetPathName, Len(swApp.ActiveDoc.GetPathName) - Len(ASM_Name1))
'MsgBox ASM_Name2

If (ASM_Name2 = "SLDASM") Then
MsgBox "批量重命名马上开始！"

Else
MsgBox "请先打开装配体，再执行本程序！"
End

End If




'获取装配体内所有零部件名称 需要将装配体置于当前
Componets = Part.GetComponents(False)




'遍历装配体
For Each co In Componets
        If co.IsSuppressed = False Then
            If co.IsHidden(False) = False Then
            
              '地址
              Path = Left(co.GetPathName, InStrRev(co.GetPathName, "\"))
              'MsgBox Path
              '文件名+文件类型
              Name = Right(co.GetPathName, Len(co.GetPathName) - Len(Path))
              'MsgBox Name
              '完整路径
              'PN = Path + Name
              'MsgBox PN
              
              
            
              ' Open
              swApp.ActivateDoc2 Name, False, longstatus
              
              
             ' 设为当前
              Set Part = swApp.ActiveDoc
              
              
             '判断零件类型
             
             '获取自定义属性-类型
                Kind = Part.CustomInfo2("", "类型")
                'MsgBox Kind
                
                
                
                
                
                
                
                If (Kind = "标件") Then
                
             '获取自定义属性-项目号
                Num = Part.CustomInfo2("", "项目号")
                
             
             '获取自定义属性-图号
                Code = Part.CustomInfo2("", "图号")
                Code2 = Replace(Code, "/", "-")


             '获取自定义属性-名称
                Name = Part.CustomInfo2("", "名称")
                Name2 = Replace(Name, "*", "x")

                    
                    
                    
                    
                    
                    '获取零件名称
                    FileName = swApp.ActiveDoc.GetTitle()
                    'MsgBox FileName
                    '当前选中
                    boolstatus = Part.Extension.SelectByID2(FileName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                    '重命名
                    longstatus = Part.Extension.RenameDocument(Num + "-" + Code2 + Name2)
                    '刷新
                    boolstatus = Part.EditRebuild3()
                    '保存
                    boolstatus = Part.Save
                    '消息盒子
                    'MsgBox "标件！"
                
                
                
                
                
                
                
                
                ElseIf (Kind = "外购") Then
                
                
             '获取自定义属性-项目号
                Num = Part.CustomInfo2("", "项目号")
                
             
             '获取自定义属性-图号
                Code = Part.CustomInfo2("", "图号")
                Code2 = Replace(Code, "/", "-")


             '获取自定义属性-名称
                Name = Part.CustomInfo2("", "名称")
                Name2 = Replace(Name, "*", "x")
                
                
             '获取自定义属性-专业
                Class = Part.CustomInfo2("", "专业")

                If Class = "机" Then
                Class2 = "J"
                End If
                If Class = "电" Then
                Class2 = "D"
                End If
                If Class = "液" Then
                Class2 = "Y"
                End If
                If Class = "气" Then
                Class2 = "Q"
                End If


            '获取自定义属性-品牌
                Brand = Part.CustomInfo2("", "品牌")

                If Brand = "淘宝" Then
                Brand2 = "(淘)"
                Else
                Brand2 = Brand
                End If
                
                
                    '获取零件名称
                    FileName = swApp.ActiveDoc.GetTitle()
                    'MsgBox FileName
                    '当前选中
                    boolstatus = Part.Extension.SelectByID2(FileName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                    '重命名
                    longstatus = Part.Extension.RenameDocument(Num + "-" + "W" + "-" + Class2 + "-" + Brand2 + "-" + Name2 + "-" + Code2)
                    '刷新
                    boolstatus = Part.EditRebuild3()
                    '保存
                    boolstatus = Part.Save
                    '消息盒子
                    'MsgBox "外购！"
                    
                    
                    
                    
                    
                    
                
                
                Else
                
                
                  '获取自定义属性-图号
                    Code = Part.CustomInfo2("", "图号")
                    Code2 = Replace(Code, "/", "-")
                    
                    
                    '获取零件名称
                    FileName = swApp.ActiveDoc.GetTitle()
                    'MsgBox FileName
                    '当前选中
                    boolstatus = Part.Extension.SelectByID2(FileName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                    '重命名
                    longstatus = Part.Extension.RenameDocument(Code2)
                    '刷新
                    boolstatus = Part.EditRebuild3()
                    '保存
                    boolstatus = Part.Save
                    '消息盒子
                    'MsgBox "产品！"
                    
                    
                    
                    
                
                
                
                
                End If
                

             

            

            ' Close
            
            '获取零件新名称
            NewFileName = swApp.ActiveDoc.GetTitle()
            'MsgBox NewFileName
            swApp.CloseDoc NewFileName

                
                

            End If
        End If
    Next


'执行完毕提示
MsgBox "批量重命名已完成！"





                   '最后刷新保存


                    '设为当前
                    Set Part = swApp.ActiveDoc
                    '刷新
                    boolstatus = Part.EditRebuild3()
                    '保存
                    boolstatus = Part.Save
                    '消息盒子
                    MsgBox "最后刷新！"





End Sub

完结，撒花 ~~~ ~~~~