class1.cls

solidworks二次开发

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'指定需要包含的接口
Implements SWPublished.SwAddin

'定义SldWorks API对象与SolidWorks应用程序标志
Dim iSldWorks As SldWorks.SldWorks
Dim iCookie As Long
Dim iToolbarID As Long

'入口函数
Private Function SwAddin_ConnectToSW(ByVal ThisSW As Object, ByVal Cookie As Long) As Boolean
    '连接到SolidWorks应用程序后，初始化变量
    Set iSldWorks = ThisSW
    iCookie = Cookie
    iSldWorks.SetAddinCallbackInfo App.hInstance, Me, iCookie
    
    '添加用户界面
    Call AddInterface
    
    '设置连接标志
    SwAddin_ConnectToSW = True
End Function

'出口函数
Private Function SwAddin_DisconnectFromSW() As Boolean
    '卸载用户界面
    Call RemoveInterface
    
    '设置iSldWorks为空
    Set iSldWorks = Nothing
End Function

'添加用户界面
Private Sub AddInterface()
    Call AddMenus
    Call AddToolbars
End Sub

'卸载用户界面
Private Sub RemoveInterface()
    Call RemoveMenus
    Call RemoveToolbars
End Sub

'添加二次开发菜单
Private Sub AddMenus()
    '无文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocNONE, "VB二次开发菜单", -1
    iSldWorks.AddMenuItem3 swDocNONE, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", ""
    iSldWorks.AddMenuItem3 swDocNONE, iCookie, "第三级菜单(&New)@第二级菜单@第一级菜单@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", "E:\SWExample\位图 16X16 256色\365key.bmp"
    
    '零件文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocPART, "VB二次开发菜单", -1
    iSldWorks.AddMenuItem3 swDocPART, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", ""
    iSldWorks.AddMenuItem3 swDocPART, iCookie, "插入预定义样条曲线(&S)@VB二次开发菜单", -1, "OnCreateSketch", "", "插入一个预定义的样条曲线到当前选择的基准面", ""
    iSldWorks.AddMenuItem3 swDocPART, iCookie, "生成旋转特征(&R)@VB二次开发菜单", -1, "OnCreateRotateFeat", "", "在已有草图的基础上生成一个旋转特征", ""
    iSldWorks.AddMenuItem3 swDocPART, iCookie, "特征遍历(&T)@VB二次开发菜单", -1, "OnFeatureTraverse", "", "遍历零件中的所有特征并输出特征名称", ""
    iSldWorks.AddMenuItem3 swDocPART, iCookie, "第三级菜单(&New)@第二级菜单@第一级菜单@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", "E:\SWExample\位图 16X16 256色\365key.bmp"
 
    '装配体文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocASSEMBLY, "VB二次开发菜单", -1
    iSldWorks.AddMenuItem3 swDocASSEMBLY, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", ""
    iSldWorks.AddMenuItem3 swDocASSEMBLY, iCookie, "第三级菜单(&New)@第二级菜单@第一级菜单@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", "E:\SWExample\位图 16X16 256色\365key.bmp"
    
    '工程图文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocDRAWING, "VB二次开发菜单", -1
    iSldWorks.AddMenuItem3 swDocDRAWING, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", ""
    iSldWorks.AddMenuItem3 swDocDRAWING, iCookie, "第三级菜单(&New)@第二级菜单@第一级菜单@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件", "E:\SWExample\位图 16X16 256色\365key.bmp"
End Sub

'删除添加的菜单
Private Sub RemoveMenus()
    iSldWorks.RemoveMenu swDocNONE, "VB二次开发菜单", ""
    iSldWorks.RemoveMenu swDocPART, "VB二次开发菜单", ""
    iSldWorks.RemoveMenu swDocASSEMBLY, "VB二次开发菜单", ""
    iSldWorks.RemoveMenu swDocDRAWING, "VB二次开发菜单", ""
End Sub

'添加工具栏
Private Sub AddToolbars()
    '添加工具栏上的大小图标
    Dim ret As Boolean
    iToolbarID = iSldWorks.AddToolbar4(iCookie, "VB二次开发工具栏", "E:\SWExample\位图 16X16 256色\365key.bmp", "E:\SWExample\位图 16X16 256色\365key-24.bmp", 1, swDocTemplateTypeNONE Or swDocTemplateTypePART Or swDocTemplateTypeASSEMBLY Or swDocTemplateTypeDRAWING)
    iToolbarID = iSldWorks.AddToolbar4(iCookie, "VB二次开发工具栏", "E:\SWExample\位图 16X16 256色\baidu.bmp", "E:\SWExample\位图 16X16 256色\baidu-24.bmp", 2, swDocTemplateTypeNONE Or swDocTemplateTypePART Or swDocTemplateTypeASSEMBLY Or swDocTemplateTypeDRAWING)
    iToolbarID = iSldWorks.AddToolbar4(iCookie, "VB二次开发工具栏", "E:\SWExample\位图 16X16 256色\banerzhuan.bmp", "E:\SWExample\位图 16X16 256色\banerzhuan-24.bmp", 3, swDocTemplateTypeNONE Or swDocTemplateTypePART Or swDocTemplateTypeASSEMBLY Or swDocTemplateTypeDRAWING)
    iToolbarID = iSldWorks.AddToolbar4(iCookie, "VB二次开发工具栏", "E:\SWExample\位图 16X16 256色\bokee.bmp", "E:\SWExample\位图 16X16 256色\bokee-24.bmp", 4, swDocTemplateTypeNONE Or swDocTemplateTypePART Or swDocTemplateTypeASSEMBLY Or swDocTemplateTypeDRAWING)
    If iToolbarID = -1 Then
        MsgBox "添加工具栏失败"
        Exit Sub
    End If
    '添加工具栏按钮的响应函数
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 1, "OnNewPartdoc", "", "新建零件", "新建一个零件文档")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 2, "OnCreateSketch", "", "插入草图", "插入预定义草图")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 3, "OnCreateRotateFeat", "", "生成旋转特征", "在已有草图的基础上生成一个旋转特征")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 4, "OnFeatureTraverse", "", "特征遍历", "遍历零件中的所有特征并输出特征名称")
End Sub

'删除工具栏
Private Sub RemoveToolbars()
    Dim ret As Boolean
    ret = iSldWorks.RemoveToolbar2(iCookie, iToolbarID)
End Sub

'菜单“新建零件文档”的响应函数(Main类中的OnNewPartDoc过程要被SldWorks类中的函数调用，所以应设为Public类型)
Public Sub OnNewPartDoc()
    '新建一个零件文档
    Dim Part As PartDoc
    Set Part = iSldWorks.NewPart
    If Part Is Nothing Then
        MsgBox "新建零件文档失败"
    Else
        MsgBox "新建零件文档成功"
    End If
End Sub

'菜单“插入预定义样条曲线”的响应函数(Main类中的OnCreateSketch过程要被SldWorks类中的函数调用，所以应设为Public类型)
Public Sub OnCreateSketch()
    '得到当前活动文档
    Dim modelDoc As ModelDoc2
    Set modelDoc = iSldWorks.ActiveDoc
    If modelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Sub
    End If
    
    '进入草图模式，True表示生成草图后更新
    modelDoc.InsertSketch2 True
    
    '调用样条曲线命令生成曲线
    modelDoc.SketchSpline 3, 0.008, 0.027, 0
    modelDoc.SketchSpline 2, 0.006, 0, 0
    modelDoc.SketchSpline 1, 0.02, -0.025, 0
    modelDoc.SketchSpline 0, 0.01, -0.045, 0
    
    '调用直线命令生成直线。ConstructionGeometry为True表示中心线
    modelDoc.CreateLine2(0, 0.04, 0, 0, -0.05, 0).ConstructionGeometry = True
End Sub

'菜单“生成旋转特征”的响应函数(Main类中的OnCreateRotateFeat过程要被SldWorks类中的函数调用，所以应设为Public类型)
Public Sub OnCreateRotateFeat()
    '得到当前活动文档
    Dim modelDoc As ModelDoc2
    Set modelDoc = iSldWorks.ActiveDoc
    If modelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Sub
    End If
    
    '调用旋转特征命令，生成旋转特征（旋转角度为360度，弧度为6.2831853071796）
    Dim angle As Double
    angle = 6.2831853071796
    '得到特征生成的接口函数
    Dim featManager As FeatureManager
    Set featManager = modelDoc.FeatureManager
    If featManager Is Nothing Then
        MsgBox "不能得到特征生成的管理接口"
        Exit Sub
    End If
    
    '调用旋转生成特征的命令
    Dim ret As Boolean
    ret = featManager.FeatureRevolveThin(angle, False, 0, 0, 0.001, 0.001, 0, True, True, True)
    
    '调用直线命令生成直线。ConstructionGeometry为True表示中心线
    modelDoc.CreateLine2(0, 0.04, 0, 0, -0.05, 0).ConstructionGeometry = True
End Sub

'菜单“特征遍历”的响应函数
Public Sub OnFeatureTraverse()
    '得到当前活动文档
    Dim modelDoc As ModelDoc2
    Set modelDoc = iSldWorks.ActiveDoc
    If modelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Sub
    End If
    
    '判断文档类型
    Dim iDocType As Long
    iDocType = modelDoc.GetType()
    '如果文档类型为零件，进行遍历
    If iDocType = swDocPART Then
        '得到文档中的第一个特征
        Dim iFeature As Feature
        Set iFeature = modelDoc.FirstFeature
        '定义字符串变量用于保存特征的名称
        Dim featNames As String
        '得到文档的名称，vbCrLf为一个换行符
        Dim docName As String
        docName = modelDoc.GetTitle
        featNames = "零件名称：" + docName
        featNames = featNames + vbCrLf + "零件中的特征名称如下："
        '进入循环，进行特征遍历
        For i = 1 To modelDoc.GetFeatureCount
            '获取特征名称
            Dim ftName As String
            ftName = iFeature.Name
            '将特征名称写入字符串
            featNames = featNames + vbCrLf + ftName
            Debug.Print featNames
            '获取下一个特征
            Dim featTemp As Feature
            Set featTemp = iFeature.GetNextFeature
            Set iFeature = featTemp
        Next i
        '输出特征名称
        MsgBox featNames
    Else
        MsgBox "不是零件文档，本程序只是针对零件文档进行特征遍历"
    End If
End Sub