frmpart.frm

用VB6.0进行solidworks的二次开发

      End
      Begin VB.Menu itmVersion 
         Caption         =   "版本"
         Shortcut        =   ^V
      End
   End
End
Attribute VB_Name = "frmPart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    '定义用户在树状列表中的选择
    Dim UserSelect
    '定义BkMrk变量表示用户在DataGrid中选择了哪一行
    Dim BkMrk As Integer
    '定义一个ModelDoc2对象变量
    Dim Model As ModelDoc2
    '定义一个solidworks对象
    Dim swapp As SldWorks.SldWorks
    '定义一个零件文件对象
    Dim part As Object
    '定义管理器对象
    Dim selmgr As Object
    '定义特征对象
    Dim feature As Object
    '定义几个solidworks中常用数据
    Dim longstatus As Long, longwarnings As Long
    Dim boolstatus As Boolean
    '定义两个分别表示零件模版文件路径和目标保存路径的字符串变量
    Dim SourcePath, SavePath As String
    
    '以下变量为大摩擦轮的几个参数化尺寸
    Dim ZhiJing, KongJing, HouDu As Single
    
    '以下变量为工字轨的几个参数化尺寸
    Dim Chang, BanKuan, BanHou, Gao, LiangHou As Single
    
Private Sub cmd3DModel_Click()
    '调用建模函数
    Select Case UserSelect
        Case "大摩擦轮"
            Call DaMoCaLun
        Case "工字轨"
            Call GongZiGui
    End Select
    '最小化自身窗口
    Me.WindowState = 1
    
End Sub

Private Sub cmdArrange_Click()
    '切换到方案布置窗口
    Load frmTQMF: frmTQMF.Show: Unload frmPart
    
End Sub



Private Sub ctlTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim strQuery As String
    UserSelect = Node.Text
    Select Case UserSelect
        Case "零件"
            DataGrid1.Visible = False
            imgTQ.Visible = True
        Case "大摩擦轮"
            imgTQ.Visible = False
            '将大摩擦轮表中数据填入DataGrid控件显示
            DataGrid1.Visible = True
            DataGrid1.Caption = "大摩擦轮(mm)"
            strQuery = "SELECT * FROM 大摩擦轮 order by 型号"
            Adodc1.RecordSource = strQuery
            Adodc1.Refresh
            '加载零件预览图片并可见
            imgYuLan.Visible = True
            imgYuLan.Picture = LoadPicture("f:\天奇参数化工程\零件预览图片库\大摩擦轮.bmp")
            'txtNote可见
            txtNote.Visible = True
            txtNote.Text = "大摩擦轮由电机驱动，为主动轮。"
            '三个按钮可见
            cmdArrange.Visible = True: cmdDesign.Visible = True: cmd3DModel.Visible = True
            '参数设计按钮不可用
            cmdDesign.Enabled = False
            
        Case "小摩擦轮"
            imgTQ.Visible = False
            DataGrid1.Visible = True
            DataGrid1.Caption = "小摩擦轮(mm)"
            strQuery = "SELECT * FROM 小摩擦轮 order by 型号"
            Adodc1.RecordSource = strQuery
            Adodc1.Refresh
            
        Case "工字轨"
            imgTQ.Visible = False
            '导入数据
            DataGrid1.Visible = True
            DataGrid1.Caption = "工字轨(mm)"
            strQuery = "SELECT * FROM 工字轨 order by 型号"
            Adodc1.RecordSource = strQuery
            Adodc1.Refresh
            '加载零件预览图片并可见
            imgYuLan.Visible = True
            imgYuLan.Picture = LoadPicture("f:\天奇参数化工程\零件预览图片库\工字轨.bmp")
            'txtNote可见
            txtNote.Visible = True
            txtNote.Text = "工字轨由三块钢板焊接而成。"
            '三个按钮可见
            cmdArrange.Visible = True: cmdDesign.Visible = True: cmd3DModel.Visible = True
            '参数设计按钮不可用
            cmdDesign.Enabled = False
            
    End Select
    
End Sub

Private Sub DataGrid1_Click()
    '监视用户选择了DataGrid控件的哪一行，并导入相应数据给参数化建模时的驱动变量
    BkMrk = DataGrid1.Bookmark
    Select Case UserSelect
        Case "大摩擦轮"
            Select Case BkMrk
                Case 1
                    DataGrid1.Row = 0: DataGrid1.Col = 1
                    ZhiJing = DataGrid1.Text
                    DataGrid1.Row = 0: DataGrid1.Col = 2
                    KongJing = DataGrid1.Text
                    DataGrid1.Row = 0: DataGrid1.Col = 3
                    HouDu = DataGrid1.Text
                Case 2
                    DataGrid1.Row = 1: DataGrid1.Col = 1
                    ZhiJing = DataGrid1.Text
                    DataGrid1.Row = 1: DataGrid1.Col = 2
                    KongJing = DataGrid1.Text
                    DataGrid1.Row = 1: DataGrid1.Col = 3
                    HouDu = DataGrid1.Text
                Case 3
                    DataGrid1.Row = 2: DataGrid1.Col = 1
                    ZhiJing = DataGrid1.Text
                    DataGrid1.Row = 2: DataGrid1.Col = 2
                    KongJing = DataGrid1.Text
                    DataGrid1.Row = 2: DataGrid1.Col = 3
                    HouDu = DataGrid1.Text
            End Select
        Case "工字轨"
            Select Case BkMrk
                Case 1
                    DataGrid1.Row = 0: DataGrid1.Col = 1
                    Chang = DataGrid1.Text
                    DataGrid1.Row = 0: DataGrid1.Col = 2
                    BanKuan = DataGrid1.Text
                    DataGrid1.Row = 0: DataGrid1.Col = 3
                    BanHou = DataGrid1.Text
                    DataGrid1.Row = 0: DataGrid1.Col = 4
                    Gao = DataGrid1.Text
                    DataGrid1.Row = 0: DataGrid1.Col = 5
                    LiangHou = DataGrid1.Text
                Case 2
                    DataGrid1.Row = 1: DataGrid1.Col = 1
                    Chang = DataGrid1.Text
                    DataGrid1.Row = 1: DataGrid1.Col = 2
                    BanKuan = DataGrid1.Text
                    DataGrid1.Row = 1: DataGrid1.Col = 3
                    BanHou = DataGrid1.Text
                    DataGrid1.Row = 1: DataGrid1.Col = 4
                    Gao = DataGrid1.Text
                    DataGrid1.Row = 1: DataGrid1.Col = 5
                    LiangHou = DataGrid1.Text
            End Select
    End Select
        
End Sub

Private Sub Form_Load()
    '设置树状列表
    Dim NewNode As Node
    Set NewNode = ctlTreeView.Nodes.Add(, , "R1", "零件")
    Set NewNode = ctlTreeView.Nodes.Add("R1", tvwChild, "RC1", "大摩擦轮")
    Set NewNode = ctlTreeView.Nodes.Add("R1", tvwChild, "RC2", "小摩擦轮")
    Set NewNode = ctlTreeView.Nodes.Add("R1", tvwChild, "RC3", "工字轨")
    '设置公司界面图片的大小位置
    imgTQ.Left = 4440: imgTQ.Width = 14655: imgTQ.Top = 0: imgTQ.Height = 9615
    '设置TreeView控件在屏幕上的大小位置
    ctlTreeView.Left = 0: ctlTreeView.Width = 4455: ctlTreeView.Top = 0: ctlTreeView.Height = 9615
    '设置DataGrid控件在屏幕上的大小位置,且初始化时为不可见
    DataGrid1.Left = 4440: DataGrid1.Width = 14655: DataGrid1.Top = 0: DataGrid1.Height = 5280: DataGrid1.Visible = False
    'DataGrid控件中的数据不允许被修改
    DataGrid1.AllowUpdate = False
    '设置预览图片框imgYuLan的大小位置,且初始不可见
    imgYuLan.Left = 4440: imgYuLan.Width = 6210: imgYuLan.Top = 5400: imgYuLan.Height = 4170: imgYuLan.Visible = False
    '设置备忘录txtNote的大小位置，且初始不可见
    txtNote.Left = 10680: txtNote.Width = 5895: txtNote.Top = 5400: txtNote.Height = 3855: txtNote.Visible = False
    '设置三个按钮不可见
    cmdArrange.Visible = False: cmdDesign.Visible = False: cmd3DModel.Visible = False
    '参数设计菜单项不可用
    itmPart.Enabled = False
    
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    ctlTreeView.Height = Me.ScaleHeight - (ctlTreeView.Top * 2)
    
End Sub

Public Function DaMoCaLun()
    '为字符串变量赋值
    SourcePath = "f:\天奇参数化工程\零部件模版库\大摩擦轮.SLDPRT"
    SavePath = "f:\天奇参数化工程\参数生成零件库\大摩擦轮.SLDPRT"
    '复制模版文件
    FileCopy SourcePath, SavePath
    '打开solidworks
    Set swapp = CreateObject("Sldworks.Application")
    '显示solidworks窗口
    swapp.Visible = True
    '打开模版备份大摩擦轮零件并激活
    Set Model = swapp.OpenDoc6(SavePath, 1, 0, "", longstatus, longwarnings)
    Set Model = swapp.ActiveDoc
    '关闭捕捉功能
    Model.SetAddToDB (True)
    '激活当前文档
    Set part = swapp.ActiveDoc
    Set selmgr = part.SelectionManager
    '修改零件尺寸,参数化驱动建模
    boolstatus = part.Extension.SelectByID2("外径@草图1@大摩擦轮.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("外径@草图1").SystemValue = ZhiJing / 1000
    boolstatus = part.Extension.SelectByID2("内径@草图2@大摩擦轮.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("内径@草图2").SystemValue = KongJing / 1000
    boolstatus = part.Extension.SelectByID2("厚度@拉伸1@大摩擦轮.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("厚度@拉伸1").SystemValue = HouDu / 1000
    part.ClearSelection2 True
    boolstatus = part.EditRebuild3
    part.ShowNamedView2 "*等轴测", 7
    part.ViewZoomtofit2
    
End Function

Public Function GongZiGui()
    '为字符串变量赋值
    SourcePath = "f:\天奇参数化工程\零部件模版库\工字轨.SLDPRT"
    SavePath = "f:\天奇参数化工程\参数生成零件库\工字轨.SLDPRT"
    '复制模版文件
    FileCopy SourcePath, SavePath
    '打开solidworks
    Set swapp = CreateObject("Sldworks.Application")
    '显示solidworks窗口
    swapp.Visible = True
    '打开模版备份工字轨零件并激活
    Dim longstatus As Long, longwarnings As Long
    Set Model = swapp.OpenDoc6(SavePath, 1, 0, "", longstatus, longwarnings)
    Set Model = swapp.ActiveDoc
    '关闭捕捉功能
    Model.SetAddToDB (True)
    '激活当前文档
    Set part = swapp.ActiveDoc
    Set selmgr = part.SelectionManager
    '修改零件尺寸,参数化驱动建模
    boolstatus = part.Extension.SelectByID2("板宽@草图1@工字轨.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("板宽@草图1").SystemValue = BanKuan / 1000
    boolstatus = part.Extension.SelectByID2("板厚@草图1@工字轨.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("板厚@草图1").SystemValue = BanHou / 1000
    boolstatus = part.Extension.SelectByID2("高@草图1@工字轨.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("高@草图1").SystemValue = Gao / 1000
    boolstatus = part.Extension.SelectByID2("长@拉伸1@工字轨.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("长@拉伸1").SystemValue = Chang / 1000
    boolstatus = part.Extension.SelectByID2("梁厚@草图1@工字轨.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
    part.Parameter("梁厚@草图1").SystemValue = LiangHou / 1000
    part.ClearSelection2 True
    boolstatus = part.EditRebuild3
    part.ShowNamedView2 "*等轴测", 7
    part.ViewZoomtofit2
    
End Function

Private Sub itmArrange_Click()
    '切换到方案布置界面
    Load frmTQMF
    frmTQMF.Show
    Unload frmPart
    
End Sub

Private Sub itmExit_Click()
    '退出程序
    Unload Me
    
End Sub