AnsweredAssumed Answered

AddCustomInfo3

Question asked by Yong Ning on Jun 14, 2015

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

Attachments

Outcomes