AddCustomInfo3 的应用

chenbiner12

   经典图书

按个人要求定制自己的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)

2015-6-15 15:16 上传

点击文件名下载附件
下载积分: 金币 -1

2409018

大谢！希望自己也能学会。