0 Replies Latest reply on Jun 14, 2015 7:52 AM by Yong Ning

    AddCustomInfo3

    Yong Ning

      Function NameDimStr(SwModel As ModelDoc2, SwConf As Configuration, Rng As Range, Name)

         Dim Str

         'Stop

           ''

             If Rng.Columns.Count = 3 Then

               Ww = """" & Rng(1, 1) & "@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

               Hh = """" & Rng(1, 2) & "@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

               Delta = """" & Rng(1, 3) & "@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

               Str = Name & Ww & "×" & Hh & " δ=" & Delta

             ElseIf Rng.Columns.Count = 2 Then

             End If

             SwModel.AddCustomInfo3 SwConf.Name, "名称", 30, Str

          

      End Function

      Function PlateCutDimStr(SwModel As ModelDoc2, SwConf As Configuration, Rng As Range)

         Dim Str, Str1, Ww, Hh, Delta

         'Stop

           ''

             If Rng.Columns.Count = 3 Then

               Ww = """" & Rng(1, 1) & "@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

               Hh = """" & Rng(1, 2) & "@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

               Delta = """" & Rng(1, 3) & "@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

               Str = Ww & "×" & Hh & " δ=" & Delta

               Str1 = Ww & "×" & Hh & "×" & Delta

             ElseIf Rng.Columns.Count = 2 Then

             End If

             SwModel.AddCustomInfo3 SwConf.Name, "下料尺寸", 30, "板材 " & Str

             SwModel.AddCustomInfo3 SwConf.Name, "下料公式", 30, "(" & Str1 & ")×" & formulaStr

             Ww = SwModel.Parameter(Rng(1, 1)).Value

             Hh = SwModel.Parameter(Rng(1, 2)).Value

             Delta = SwModel.Parameter(Rng(1, 3)).Value

             SwModel.AddCustomInfo3 SwConf.Name, "下料质量", 30, Format(Ww * Hh * Delta * 7.85 * 10 ^ -6, "0.0")

             'Stop

          

      End Function

      ''

      Private Sub lll2()

          Dim Xls As Excel.Application, Rng As Range

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

             Set Rng = Xls.Selection

             ''

          Dim CustArr, CustArray, ii, jj, Str

             CustArray = Array("图号", "名称", "材料", "质量", "下料尺寸", "下料质量", "图纸张数")

          Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

             Set SwApp = Application.SldWorks

             Set SwModel = SwApp.ActiveDoc

          Dim SwConf As Configuration, ConfArr

             ConfArr = SwModel.GetConfigurationNames

          'On Error Resume Next

             For ii = 1 To Rng.Areas(2).Rows.Count

                ''

                Set SwConf = SwModel.GetConfigurationByName(Rng.Areas(2)(ii, 1))

                SwModel.ShowConfiguration2 SwConf.Name

                CustArr = SwModel.GetCustomInfoNames2(SwConf.Name)

                For jj = 0 To UBound(CustArr)

                   SwModel.DeleteCustomInfo2 SwConf.Name, CustArr(jj)

                Next jj

                'Stop

                ''Debug.Print SwConf.Name

                For jj = 0 To UBound(CustArray)

                  

                   Select Case CustArray(jj)

                      Case "材料"

                           Str = """SW-Material@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

                           SwModel.AddCustomInfo3 SwConf.Name, "材料", 30, Str

                      Case "质量"

                           Str = """SW-Mass@@" & SwConf.Name & "@" & SwModel.GetTitle & """"

                           SwModel.AddCustomInfo3 SwConf.Name, "质量", 30, Str

                     

                      'Case "下料质量"

                           'SwModel.AddCustomInfo3 SwConf.Name, "下料质量", 30, """" & "MatWt@" & SwConf.Name & "@" & SwModel.GetTitle & """"

                      Case "名称"

                           NameDimStr SwModel, SwConf, Rng.Areas(1), "筋板 "

                      Case "下料尺寸"

                           PlateCutDimStr SwModel, SwConf, Rng.Areas(1)

                      'Case Else

                         'SwModel.AddCustomInfo3 SwConf.Name, CustArray(jj), 30, "   "

                        

                   End Select

                  

                Next jj

                ''Stop

             Next ii

      End Sub