SolidWorks机械工程师网——最大的SolidWorks学习平台

标题: AddCustomInfo3 的应用 [打印本页]

作者: chenbiner12 时间: 2015-6-15 15:16
标题: AddCustomInfo3 的应用
按个人要求定制自己的solidworks属性。

''
Private Sub AddCustMatWt()
Dim PrtCustArray, AsmCustArray, ii, jj, Str
PrtCustArray = Array("图号", "名称", "材料", "质量", "下料尺寸", "下料质量", "下料公式", "图纸张数")
AsmCustArray = Array("图号", "名称", "材料", "质量", "图纸张数")
''
Dim Xls As Excel.Application, Rng As Range, FileName
Set Xls = GetObject(, "Excel.Application")
Set Rng = Xls.Selection
Dim Sht As Worksheet, Arr
Set Sht = Rng.Parent
''
Dim R1 As Range, R2 As Range, R3 As Range
Set R1 = Rng.Areas(1)
Set R2 = Rng.Areas(2)
Set R3 = Rng.Areas(3)
''
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Dim SwConf As Configuration, ConfArr, CustArr
''
For jj = 1 To R1.Columns.Count
FileName = R1(1, jj)
If UCase(FileName) Like "*SLDPRT" Then
Set SwModel = SwApp.OpenDoc(FileName, swDocPART)
ElseIf UCase(FileName) Like "*SLDASM" Then
Set SwModel = SwApp.OpenDoc(FileName, swDocASSEMBLY)
ElseIf UCase(FileName) Like "*SLDDRW" Then
Set SwModel = SwApp.OpenDoc(FileName, swDocASSEMBLY)
End If
''
ConfArr = SwModel.GetConfigurationNames
For ii = 1 To R2.Rows.Count
Str = ConfArr(ii)
''
If Str Like "*" & Sht.Cells(R2(ii, 1).Row, 1) Then
'Debug.Print SwModel.GetTitle, Str, Sht.Cells(R2(ii, 1).Row, 1).Address, Sht.Cells(R2(ii, 1).Row, 1)
SwModel.ShowConfiguration2 ConfArr(ii)
Set SwConf = SwModel.GetConfigurationByName(ConfArr(ii))
''Stop
CustArr = SwModel.GetCustomInfoNames2(SwConf.Name)
For kk = 0 To UBound(CustArr)
SwModel.DeleteCustomInfo2 SwConf.Name, CustArr(kk)
Next kk
''
If UCase(FileName) Like "*SLDPRT" Then
Arr = PrtCustArray
ElseIf UCase(FileName) Like "*SLDASM" Then
Arr = AsmCustArray
End If
For kk = 0 To UBound(Arr)
Select Case Arr(kk)
Case "材料"
Str = """SW-Material@@" & SwConf.Name & "@" & SwModel.GetTitle & """"
SwModel.AddCustomInfo3 SwConf.Name, "材料", 30, Str
Case "质量"
If UCase(FileName) Like "*SLDPRT" Then
Str = """SW-Mass@@" & SwConf.Name & "@" & SwModel.GetTitle & """"
ElseIf UCase(FileName) Like "*SLDASM" Then
Str = "组合件"
End If
''
SwModel.AddCustomInfo3 SwConf.Name, "质量", 30, Str
Case "图号"
Str = R3(ii, jj)
SwModel.AddCustomInfo3 SwConf.Name, "图号", 30, Str
Case "图纸张数"
Str = R1(ii, jj)
SwModel.AddCustomInfo3 SwConf.Name, "图纸张数", 30, Str
Case Else
SwModel.AddCustomInfo3 SwConf.Name, Arr(kk), 30, " "
End Select
Next kk
'Stop
End If
Next ii
SwModel.Save
SwApp.CloseDoc SwModel.GetTitle
Next jj
End Sub

复制代码

Macro1.zip (29.74 KB, 下载次数: 180)

作者: 2409018 时间: 2015-6-15 15:22
大谢！希望自己也能学会。

欢迎光临 SolidWorks机械工程师网——最大的SolidWorks学习平台 (https://www.swbbsc.com/)