1 Reply Latest reply on Feb 26, 2015 10:52 PM by Yong Ning

    Design table → Browse to locate the table with API

    Yong Ning

      1.jpg

       

       

      Hope use API finish

      From file. References a Microsoft Excel table. Click Browse to locate the table.

        • Re: Design table → Browse to locate the table with API
          Yong Ning

          Find method

           

          '---------------------------------------

          '

          ' Preconditions: Part or assembly document is open and contains a design table.

          '

          ' Postconditions: None

          '

          '----------------------------------------

          Option Explicit

          Sub main()

              Dim swApp                   As SldWorks.SldWorks

              Dim swModel                 As SldWorks.ModelDoc

              Dim swDesTable              As SldWorks.DesignTable

              Dim nTotRow                 As Long

              Dim nTotCol                 As Long

              Dim sRowStr                 As String

              Dim i                       As Long

              Dim j                       As Long

              Dim bRet                    As Boolean

              Set swApp = CreateObject("SldWorks.Application")

              Set swModel = swApp.ActiveDoc

              Set swDesTable = swModel.GetDesignTable

           

              bRet = swDesTable.Attach

              Debug.Assert bRet

           

              nTotRow = swDesTable.GetTotalRowCount

              nTotCol = swDesTable.GetTotalColumnCount

           

              Debug.Print "File = " & swModel.GetPathName

              Debug.Print "  Title        = " & swDesTable.GetTitle

              Debug.Print "  Row          = " & swDesTable.GetRowCount

              Debug.Print "  Col          = " & swDesTable.GetColumnCount

              Debug.Print "  TotRow       = " & nTotRow

              Debug.Print "  TotCol       = " & nTotCol

              Debug.Print "  VisRow       = " & swDesTable.GetVisibleRowCount

              Debug.Print "  VisCol       = " & swDesTable.GetVisibleColumnCount

              Debug.Print ""

           

              For i = 0 To nTotRow

                  sRowStr = "  |"

                  For j = 0 To nTotCol

                      sRowStr = sRowStr + swDesTable.GetEntryText(i, j) + "|"

                  Next j

                  Debug.Print sRowStr

              Next i

           

              swDesTable.Detach

          End Sub

          '---------------------------------------

           

          ''

          Function MassAndMaterialRng(SwModel As ModelDoc2, TitleRng As Range, Rng As Range)

             Dim Sht As Worksheet, Str, Row, Col

               Set Sht = Rng.Parent

              

             Dim cMassRng As Range, MassRng As Range, MatRng As Range

               Set cMassRng = TitleRng.Find("质量")

               Set MassRng = TitleRng.Find("mass")

               Set MatRng = TitleRng.Find("Material")

               ''

               For ii = 1 To Rng.Rows.Count

                 Row = Rng(ii, 1).Row

                 Str = Rng(ii, 1) & "@" & SwModel.GetTitle

                

                 If Not cMassRng Is Nothing Then

                    Debug.Print Sht.Cells(Row, cMassRng.Column).Address,

                    Sht.Cells(Row, cMassRng.Column) = """" & "SW-Mass@@" & Str & """"

                 End If

                 ''

                 If Not MassRng Is Nothing Then

                    Sht.Cells(Row, MassRng.Column) = """" & "SW-Mass@@" & Str & """"

                 End If

                 ''

                 If Not MatRng Is Nothing Then

                    Debug.Print Sht.Cells(Row, MatRng.Column).Address

                    Sht.Cells(Row, MatRng.Column) = """" & "SW-Material@@" & Str & """"

                 End If

              Next ii

              'Stop

          End Function

           

           

           

           

           

           

          Function delDesign(SwModel As ModelDoc2)

             Dim SwFeat As Feature

                ''

                Set SwFeat = SwModel.FirstFeature

                Do While Not SwFeat Is Nothing

                   'Debug.Print SwFeat.Name, SwFeat.GetTypeName

                   If SwFeat.GetTypeName = "DesignTableFeature" Then

                     SwFeat.Select True

                     SwModel.EditDelete

                     Exit Do

                   End If

                   Set SwFeat = SwFeat.GetNextFeature

                Loop

             Dim ConfArr, SwConf As Configuration

                ConfArr = SwModel.GetConfigurationNames

                Set SwConf = SwModel.GetConfigurationByName(ConfArr(0))

                SwModel.ShowConfiguration2 SwConf.Name

                For ii = 1 To UBound(ConfArr)

                  

                   'Set SwConf = SwModel.GetConfigurationByName(ConfArr(ii))

                   SwModel.DeleteConfiguration2 ConfArr(ii)

                   'Stop

                  

                Next ii

          End Function

           

           

          Function TwoRngInsertDesign(SwModel As ModelDoc2, TitleRng As Range, Rng As Range)

              ''汉字处理

             

              Dim Str, MassRng As Range, MaterialRng As Range

                 Set MassRng = TitleRng.Find("@质量")

                 Set MaterialRng = TitleRng.Find("材料")

              For ii = 1 To Rng.Rows.Count

                 Str = Chr(34) & "SW-Mass@@" & Rng(ii, 1) & "@" & SwModel.GetTitle & Chr(34)

                 Rng(ii, MassRng.Column) = Str

                 Str = Chr(34) & "SW-Material@@" & Rng(ii, 1) & "@" & SwModel.GetTitle & Chr(34)

                 Rng(ii, MaterialRng.Column) = Str

              Next ii

             

            Dim Wk As Workbook

             

             

              SwModel.InsertFamilyTableNew

            Dim SwOleObj As SwOLEObject, vOle, Vv As Long

              vOle = SwModel.Extension.GetOLEObjects(Vv)

              Set SwOleObj = vOle(1)

              Set Wk = SwOleObj.SetActive(True)

              ''

              TitleRng.Copy

              With Wk.Sheets(1).Range("A2")

                     .PasteSpecial xlPasteValues

                     .PasteSpecial xlPasteFormats

                     .PasteSpecial xlPasteColumnWidths

              End With

              Rng.Copy

              With Wk.Sheets(1).Range("A3")

                     .PasteSpecial xlPasteValues

                     .PasteSpecial xlPasteFormats

              End With

              SwOleObj.SetActive False

            Dim SwDesgTab As SldWorks.DesignTable

              Set SwDesgTab = SwModel.GetDesignTable

              SwDesgTab.Attach

              SwModel.CloseFamilyTable

              For ii = 1 To Rng.Rows.Count

                 'Debug.Print SwModel.CustomInfo2(Rng(ii, 1), "质量"),

                 'Debug.Print SwModel.GetCustomInfoValue(Rng(ii, 1), "质量"),

                 Rng(ii, MassRng.Column) = SwModel.GetCustomInfoValue(Rng(ii, 1), "质量")

                 Rng(ii, MaterialRng.Column) = SwModel.GetCustomInfoValue(Rng(ii, 1), "材料")

                

              Next ii

             

              ''

          End Function

           

           

           

           

          Sub deldel()

            Dim Xls As Excel.Application

              Set Xls = GetObject(, "Excel.Application")

            Dim Sht As Worksheet, Rng As Range, TitleRng As Range

              Set Rng = Xls.Selection

              Set Sht = Rng.Parent

              With Sht

                 Set TitleRng = .Range(.Cells(2, 1), .Cells(2, Rng.Columns.Count))

              End With

              ''

             Dim SwModel As ModelDoc2

                Set SwModel = Application.SldWorks.ActiveDoc

                delDesign SwModel

                TwoRngInsertDesign SwModel, TitleRng, Rng

          End Sub