参数化驱动阀体

huangyhg

Option Explicit

'定义swApp变量 （将与 Solidworks应用程序关联）

Dim swApp As SldWorks.SldWorks

Dim Part As SldWorks.ModelDoc2

Private Sub Command1_Click()

Dim rowIndex As Integer

Dim colIndex As Integer

Dim newDiameter As Integer

'读取单元行数

If IsNumeric(TxtRow.Text) Then

        rowIndex = TxtRow.Text

        Else

        rowIndex = 3

    End If

'读取单元列数

If IsNumeric(TxtCol.Text) Then

        colIndex = TxtCol.Text

        Else

        colIndex = 2

End If

'读取新外径

     If IsNumeric(TxtDiameter.Text) Then

        newDiameter = TxtDiameter.Text

        Else

        newDiameter = 20

    End If

'modify the diameter of hole

Dim rowIndex1 As Integer

Dim colIndex1 As Integer

Dim newDiameter1 As Integer



If IsNumeric(TextRow1.Text) Then

        rowIndex1 = TextRow1.Text

        Else

        rowIndex1 = 3

    End If



If IsNumeric(TextCol1.Text) Then

        colIndex1 = TextCol1.Text

        Else

        colIndex1 = 3

End If

'读取新内径

     If IsNumeric(TextHole.Text) Then

        newDiameter1 = TextHole.Text

        Else

        newDiameter1 = 18

    End If

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

'连接solidwork

Set swApp = CreateObject("SldWorks.Application")

swApp.Visible = True '让后台运行的SW显示出来

swApp.UserControl = True

'打开“参考阀体装配体.SLDASM”

Set Part = swApp.OpenDoc6("F:\毕设新资料\球阀试制\参考阀体装配体.SLDASM", 2, 0, "", longstatus, longwarnings)

'Set Part = swApp.ActiveDoc



'设定“参考阀体装配体.SLDASM” 为当前激活文档

swApp.ActivateDoc2 "参考阀体装配体.SLDASM", False, longstatus



boolstatus = Part.Extension.SelectByID2("阀体-1@参考阀体装配体", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)  '选择 组件 阀体-1@参考阀体装配体



Dim myModelDoc As SldWorks.ModelDoc2

Set myModelDoc = swApp.OpenDoc6("F:\毕设新资料\球阀试制\阀体.SLDPRT", swDocPART, 0, "", longstatus, longwarnings) '打开阀体零件

Dim nRetval  As Long

Set myModelDoc = swApp.ActivateDoc2(myModelDoc.GetPathName, True, nRetval): Debug.Assert 0 = nRetval



myModelDoc.ClearSelection2 True

'选择 系列零件设计表

boolstatus = myModelDoc.Extension.SelectByID2("系列零件设计表", "DESIGNTABLE", 0, 0, 0, False, 0, Nothing, 0)

'选择 16@阀体.SLDPRT

boolstatus = myModelDoc.Extension.SelectByID2("16@阀体.SLDPRT", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)



Dim myWorksheet As Excel.Worksheet

Dim myDesignTable As SldWorks.DesignTable

Dim cellRange As Excel.Range

Dim cellValue As String, cellText As String

Dim cellRange1 As Excel.Range

Dim cellValue1 As String, cellText1 As String

'从16@阀体.SLDPRT文档中获取设计表

Set myDesignTable = myModelDoc.GetDesignTable

If Not myDesignTable Is Nothing Then

myDesignTable.Attach



'输出当前设计表的总行/总列/开始行数/开始列数

                Debug.Print "Total Row Count = " & myDesignTable.GetTotalRowCount



                Debug.Print "      Col Count = " & myDesignTable.GetTotalColumnCount



                Debug.Print "Start Row = " & myDesignTable.GetStartRowNumber



                Debug.Print "      Col = " & myDesignTable.GetStartColumnNumber

'从当前设计表中获取表单

Set myWorksheet = myDesignTable.Worksheet

End If



If Not myWorksheet Is Nothing Then

Debug.Print ""

Debug.Print "The name of the worksheet is " & myWorksheet.Name





'获取用户界面上给定的单元格1

Set cellRange = myWorksheet.Cells(rowIndex, colIndex)

'获取用户界面上给定的单元格2

Set cellRange1 = myWorksheet.Cells(rowIndex1, colIndex1)

End If

'获取给定单元格1的旧值               

If Not cellRange Is Nothing Then

cellValue = cellRange.Value2

cellText = cellRange.Text

'设定给定单元格1的新值               

cellRange.Value2 = newDiameter

cellValue = cellRange.Value2

'在调试窗口输出给定的单元格1“旧值 新值”               

Debug.Print "Cell[" & rowIndex & "," & colIndex & "] = " & cellText & " " & cellValue & " "

End If

'获取给定单元格2的旧值               

If Not cellRange1 Is Nothing Then

cellValue1 = cellRange1.Value2

cellText1 = cellRange1.Text

'设定给定单元格2的新值               

cellRange1.Value2 = newDiameter1

cellValue1 = cellRange1.Value2

'在调试窗口输出给定的单元格2“旧值 新值”               

Debug.Print "Cell[" & rowIndex1 & "," & colIndex1 & "] = " & cellText1 & " " & cellValue1 & " "

End If

myDesignTable.UpdateModel

'myDesignTable.EditTable

'更新零件设计表               

'boolstatus = myDesignTable.UpdateTable(SwConst.swDesignTableUpdateOptions_e.swUpdateDesignTableAll, True)



myDesignTable.Detach

'选择16为阀体零件的当前配置               

'boolstatus = myModelDoc.Extension.SelectByID2("16@阀体.SLDPRT", "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0)

'boolstatus = myModelDoc.ShowConfiguration2("16")

'根据零件设计表的新数据更新阀体               

myModelDoc.Save

'关闭阀体零件               

swApp.CloseDoc myModelDoc.GetPathName

'将Solidworks置为前台程序且可见              

swApp.Visible = True

'将装配件置为当前模型              

Dim myPart As SldWorks.ModelDoc2

Set myPart = swApp.ActivateDoc2(Part.GetPathName, True, nRetval): Debug.Assert 0 = nRetval

End Sub





Private Sub Command3_Click()

'连接solidwork

Set swApp = CreateObject("SldWorks.Application")

swApp.Visible = True '让后台运行的SW显示出来

swApp.UserControl = True



End Sub