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
SolidworksApi macros