main.cls

VB二次开发。用于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
'***********************************************************************************
'《Solidworks 2006系统设计与开发》书配套程序
'作者：叶炜威  http://blog.csdn.net/re_dev_solidworks
'时间：2005.9-2006.1
'版权所有 (C)
'***********************************************************************************

'程序实体

'***********************************************************************************
'指定需要包含的接口
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

'添加用户界面
Public Function AddInterface()
    '添加二次开发菜单
    Call AddMenus
    '添加右键菜单
    Call AddPopMenuItem
    '添加二次开发工具栏
    Call AddToolbars
End Function

'卸载用户界面
Public Function RemoveInterface()

    '删除二次开发菜单
    Call RemoveMenus
    '删除二次开发工具栏
    Call RemoveToolbars
    
End Function

Public Function AddMenus()

    '无文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocNONE, "VB二次开发菜单", 5
    iSldWorks.AddMenuItem2 swDocNONE, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件"

   
    '零件文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocPART, "VB二次开发菜单", 5
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "插入预定义样条曲线(&S)@VB二次开发菜单", -1, "OnCreateSketch", "", "插入一个预定义的样条曲线到当前选择的基准面"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "生成旋转特征(&R)@VB二次开发菜单", -1, "OnCreateRotateFeat", "", "在已有草图的基础上生成一个旋转特征"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "特征遍历(&T)@VB二次开发菜单", -1, "OnFeatureTraverse", "", "遍历零件中的所有特征并输出"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "绘制体包围盒(&B)@VB二次开发菜单", -1, "OnGetBodyBox", "", "获取体包围盒并通过草图绘制命令绘制该包围盒"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "获取选择的物体(&E)@VB二次开发菜单", -1, "OnGetSelectedObj", "", "得到选择的物体及其属性"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "获取当前视图信息(&V)@VB二次开发菜单", -1, "OnGetViewInfo", "", "获取当前视图信息，包括视图坐标系和比例"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "获取零件的三角面片(&G)@VB二次开发菜单", -1, "OnTessPart", "", "获取零件文件三角面片信息，并用草图绘制命令显示"
    iSldWorks.AddMenuItem2 swDocPART, iCookie, "修改面的贴图(&T)@VB二次开发菜单", -1, "OnChangeTexture", "", "修改用户选择的面的贴图"
    
    
    '装配体文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocASSEMBLY, "VB二次开发菜单", 5
    iSldWorks.AddMenuItem2 swDocASSEMBLY, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件"
    iSldWorks.AddMenuItem2 swDocASSEMBLY, iCookie, "获取当前视图信息(&V)@VB二次开发菜单", -1, "OnGetViewInfo", "", "获取当前视图信息，包括视图坐标系和比例"
    iSldWorks.AddMenuItem2 swDocASSEMBLY, iCookie, "获取零件的三角面片(&G)@VB二次开发菜单", -1, "OnTessPart", "", "获取零件文件三角面片信息，并用草图绘制命令显示"
    iSldWorks.AddMenuItem2 swDocASSEMBLY, iCookie, "修改面的贴图(&T)@VB二次开发菜单", -1, "OnChangeTexture", "", "修改用户选择的面的贴图"
    iSldWorks.AddMenuItem2 swDocASSEMBLY, iCookie, "压缩装配体部件(&P)@VB二次开发菜单", -1, "OnSuppressComponent", "", "压缩装配体部件的包围盒比选择的部件包围盒小的部件"
    iSldWorks.AddMenuItem2 swDocASSEMBLY, iCookie, "遍历装配关系(&M)@VB二次开发菜单", -1, "OnTraverseMate", "", "遍历当前装配体文档中的所有装配关系并弹出对话框显示"
    iSldWorks.AddMenuItem2 swDocASSEMBLY, iCookie, "轻化零部件(&L)@VB二次开发菜单", -1, "OnLightWeight", "", "轻化当前装配体文档中的零部件"
              
    '工程图文档模式下的VB二次开发菜单
    iSldWorks.AddMenu swDocDRAWING, "VB二次开发菜单", 5
    iSldWorks.AddMenuItem2 swDocDRAWING, iCookie, "新建零件文档(&N)@VB二次开发菜单", -1, "OnNewPartDoc", "", "新建一个零件文件"
    iSldWorks.AddMenuItem2 swDocDRAWING, iCookie, "遍历工程图视图(&T)@VB二次开发菜单", -1, "OnTraverseView", "", "遍历装配体中的所有视图并弹出对话框显示"
          
End Function

'删除添加的菜单
Public Function RemoveMenus()
    iSldWorks.RemoveMenu swDocNONE, "VB二次开发菜单", ""
    iSldWorks.RemoveMenu swDocPART, "VB二次开发菜单", ""
    iSldWorks.RemoveMenu swDocASSEMBLY, "VB二次开发菜单", ""
    iSldWorks.RemoveMenu swDocDRAWING, "VB二次开发菜单", ""
End Function
'添加工具栏
Public Function AddToolbars()

    '添加一个工具栏
    iToolbarID = iSldWorks.AddToolbar3(iCookie, "VB二次开发工具栏", 101, 102, 0, _
                swDocTemplateTypeNONE Or swDocTemplateTypePART Or swDocTemplateTypeASSEMBLY Or swDocTemplateTypeDRAWING)
    If iToolbarID = -1 Then
        MsgBox "添加工具栏失败"
        Exit Function
    End If
    
    '添加工具栏按钮
    Dim ret As Boolean
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 0, "OnNewPartDoc", "toolbarUpdate", "新建一个零件文档", "新建一个零件文档")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 1, "OnCreateSketch", "toolbarUpdate", "插入预定义草图", "插入预定义草图")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 2, "OnCreateRotateFeat", "toolbarUpdate", "生成旋转特征", "在已有草图基础上生成一个旋转特征")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 3, "OnFeatureTraverse", "toolbarUpdate", "特征遍历", "遍历零件中的所有特征并输出特征名称")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 4, "OnGetBodyBox", "toolbarUpdate", "得到特征包围盒", "生成特征的包围盒")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 5, "OnGetSelectedObj", "toolbarUpdate", "得到选择的物体", "得到选择的物体及其属性，弹出对话框显示")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 6, "OnGetViewInfo", "toolbarUpdate", "获取当前视图信息", "获取当前视图信息，包括视图坐标系和比例")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 7, "OnTessPart", "toolbarUpdate", "获取组成零件的三角面片", "获取零件文件三角面片信息，并用草图绘制命令显示")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 8, "OnChangeTexture", "toolbarUpdate", "贴图", "修改用户选择的面的贴图")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 10, "OnSuppressComponent", "toolbarUpdate", "压缩部件", "压缩装配体中部件包围盒比选择的部件包围盒小的部件")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 11, "OnTraverseMate", "toolbarUpdate", "遍历装配关系", "遍历当前装配体文档中的所有装配关系并弹出对话框显示")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 12, "OnLightWeight", "toolbarUpdate", "轻化零部件", "遍历当前装配体，轻化其中的零部件")
    ret = iSldWorks.AddToolbarCommand2(iCookie, iToolbarID, 13, "OnTraverseView", "toolbarUpdate", "遍历工程图视图", "遍历当前工程图文档中视图并显示视图信息")
    
    
End Function
'删除工具栏
Public Function RemoveToolbars()
    '删除工具栏
    Dim ret As Boolean
    ret = iSldWorks.RemoveToolbar2(iCookie, iToolbarID)

End Function

Public Function toolbarUpdate()

End Function


'菜单"新建零件文档"响应函数
Public Function OnNewPartDoc()
    '新建一个零件文档
    Dim part As PartDoc
    Set part = iSldWorks.NewPart
    If part Is Nothing Then
        MsgBox "新建零件文档失败"
    Else
        MsgBox "新建零件文档成功"
    End If
End Function
'菜单“插入预定义草图”响应函数
'在当前选择的基准面上插入一个预定义的样条曲线
Public Function OnCreateSketch()
    
    '得到当前活动文档
    Dim modelDoc As ModelDoc2
    Set modelDoc = iSldWorks.ActiveDoc
    If modelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Function
    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
    
    '生成一条中心线，由两个点(x,y,z)定义,ConstructionGeometry为true表示为中
    modelDoc.CreateLine2(0, 0.04, 0, 0, -0.05, 0).ConstructionGeometry = True
    
    
    '返回
End Function
'菜单项“生成旋转特征”的响应函数
'在已有草图的基础上生成一个旋转特征
Public Function OnCreateRotateFeat()
    '得到当前活动文档
    Dim iModelDoc As ModelDoc2
    Set iModelDoc = iSldWorks.ActiveDoc
    If iModelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Function
    End If
    
    '调用特征生成命令，生成旋转特征
    '设置旋转角度为360度，即6.2831853071796
    Dim angle As Double
    angle = 6.2831853071796
    
    '得到特征生成管理接口
    Dim iFeatManager As FeatureManager
    Set iFeatManager = iModelDoc.FeatureManager
    If iFeatManager Is Nothing Then
        MsgBox "不能得到特征生成接口"
        Exit Function
    End If
        
    '草图为非封闭，故而生成薄壁特征
    iFeatManager.FeatureRevolveThin angle, 0, 0, 0, 0.001, 0.001, 0, 1, 1, 1
       

End Function
'菜单项“生成阵列特征”的响应函数
'函数生成一个圆周阵列特征
Public Function OnCreatePattern()
    '得到当前活动文档
    Dim iModelDoc As ModelDoc2
    Set iModelDoc = iSldWorks.ActiveDoc
    If iModelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Function
    End If
    
    '调用圆周阵列特征生成命令
    '设置旋转角度为360度，即6.2831853071796
    Dim PI As Double
    PI = 3.1415926
    
    '得到特征生成管理接口
    Dim iFeatManager As FeatureManager
    Set iFeatManager = iModelDoc.FeatureManager
    If iFeatManager Is Nothing Then
        MsgBox "不能得到特征生成接口"
        Exit Function
    End If
    
    '生成圆周阵列
    FeatureManager.FeatureCircularPattern2 6, PI / 6, False, "NULL", False
    
End Function
'菜单项“特征遍历”的响应函数
'函数将遍历当前零件文档中的所有特征并获取每个特征的名称，
'然后以弹出对话框的形式输出
Public Function OnFeatureTraverse()
    '得到当前活动文档
    Dim iModelDoc As ModelDoc2
    Set iModelDoc = iSldWorks.ActiveDoc
    If iModelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Function
    End If
    
    '判断文档类型
    Dim iDocType As Long
    iDocType = iModelDoc.GetType()
    '如果文档类型为零件进入遍历
    If iDocType = swDocPART Then
    
        '得到文档中的第一个特征
        Dim iFeature As Feature
        Set iFeature = iModelDoc.FirstFeature
        '定义字符串用于保存特征名称
        Dim featNames As String
        '得到文档名称,,vbCrLf为一个换行符
        Dim docName As String
        docName = iModelDoc.GetTitle
        featNames = "零件名称：" + docName
        featNames = featNames + vbCrLf + "零件中的特征名称如下："
        
        '进入循环进行特征遍历，以特征总数为循环终止参数
        For i = 1 To iModelDoc.GetFeatureCount
            '获取特征名称
            Dim ftName As String
            ftName = iFeature.Name
            
            '将特征名称写入字符串
            featNames = featNames + vbCrLf + ftName
            
            '获取下一个特征
            Dim featTemp As Feature
            Set featTemp = iFeature.GetNextFeature
            Set iFeature = featTemp
        Next
        
        '输出特征名称
        MsgBox featNames
    
    Else
        MsgBox "不是零件文档，本程序仅针对零件文档遍历"
    End If
    
End Function
'菜单项“获取特征包围盒”响应函数
'函数将遍历文档中的所有特征，获取每个特征的包围盒
'并调用草图绘制命令绘制该包围盒
Public Function OnGetBodyBox()
    '得到当前活动文档
    Dim iModelDoc As ModelDoc2
    Set iModelDoc = iSldWorks.ActiveDoc
    If iModelDoc Is Nothing Then
        MsgBox "不能得到当前活动文档"
        Exit Function
    End If
    
    '得到文档中的第一个特征
    Dim iFeature As Feature
    Set iFeature = iModelDoc.FirstFeature
    
        
    '定义顶点用于包围盒的绘制
    Dim boxSketchPt(8)    As SketchPoint
      
    '进入循环进行特征遍历，当特征接口对象为空时终止循环
    For i = 1 To iModelDoc.GetFeatureCount
        
        '定义变量用于保存包围盒数据
        Dim vBox As Variant
        '获取特征包围盒数据
        ret = iFeature.GetBox(vBox)
        '只有包围盒为有效时绘制，对于非实体特征（如参考面等）的则跳过
        If vBox(0) <> vBox(3) And vBox(1) <> vBox(4) And vBox(2) <> vBox(5) Then
        
            '进入3D草图绘制模式
            iModelDoc.Insert3DSketch2 True
            iModelDoc.SetAddToDB True
        
            '创建包围盒的八个顶点
            Set boxSketchPt(0) = iModelDoc.CreatePoint2(vBox(3), vBox(1), vBox(5))
            Set boxSketchPt(1) = iModelDoc.CreatePoint2(vBox(0), vBox(1), vBox(5))
            Set boxSketchPt(2) = iModelDoc.CreatePoint2(vBox(0), vBox(1), vBox(2))
            Set boxSketchPt(3) = iModelDoc.CreatePoint2(vBox(3), vBox(1), vBox(2))
            Set boxSketchPt(4) = iModelDoc.CreatePoint2(vBox(3), vBox(4), vBox(5))
            Set boxSketchPt(5) = iModelDoc.CreatePoint2(vBox(0), vBox(4), vBox(5))
            Set boxSketchPt(6) = iModelDoc.CreatePoint2(vBox(0), vBox(4), vBox(2))
            Set boxSketchPt(7) = iModelDoc.CreatePoint2(vBox(3), vBox(4), vBox(2))
        
            '绘制包围盒
            iModelDoc.CreateLine2 boxSketchPt(0).X, boxSketchPt(0).Y, boxSketchPt(0).Z, boxSketchPt(1).X, boxSketchPt(1).Y, boxSketchPt(1).Z
            iModelDoc.CreateLine2 boxSketchPt(1).X, boxSketchPt(1).Y, boxSketchPt(1).Z, boxSketchPt(2).X, boxSketchPt(2).Y, boxSketchPt(2).Z
            iModelDoc.CreateLine2 boxSketchPt(2).X, boxSketchPt(2).Y, boxSketchPt(2).Z, boxSketchPt(3).X, boxSketchPt(3).Y, boxSketchPt(3).Z
            iModelDoc.CreateLine2 boxSketchPt(3).X, boxSketchPt(3).Y, boxSketchPt(3).Z, boxSketchPt(0).X, boxSketchPt(0).Y, boxSketchPt(0).Z
            iModelDoc.CreateLine2 boxSketchPt(0).X, boxSketchPt(0).Y, boxSketchPt(0).Z, boxSketchPt(4).X, boxSketchPt(4).Y, boxSketchPt(4).Z
            iModelDoc.CreateLine2 boxSketchPt(1).X, boxSketchPt(1).Y, boxSketchPt(1).Z, boxSketchPt(5).X, boxSketchPt(5).Y, boxSketchPt(5).Z
            iModelDoc.CreateLine2 boxSketchPt(2).X, boxSketchPt(2).Y, boxSketchPt(2).Z, boxSketchPt(6).X, boxSketchPt(6).Y, boxSketchPt(6).Z
            iModelDoc.CreateLine2 boxSketchPt(3).X, boxSketchPt(3).Y, boxSketchPt(3).Z, boxSketchPt(7).X, boxSketchPt(7).Y, boxSketchPt(7).Z
            iModelDoc.CreateLine2 boxSketchPt(4).X, boxSketchPt(4).Y, boxSketchPt(4).Z, boxSketchPt(5).X, boxSketchPt(5).Y, boxSketchPt(5).Z