excel VBA 批量更改solidworks 属性的问题

xiaoxifeng

现在的问题是 ：在下面的代码的空白处加什么代码。可以达到图片的效果。就是在打开装配体的时候，自动遍历装配下的零件和数量并自动缩进

1. Dim swDM As SwDMApplication
   
2. Dim swDoc As SwDMDocument12
   
3. Dim mOpenErrors As SwDmDocumentOpenError
   
4. Dim swCfgMgr As SwDMConfigurationMgr
   
5. Dim objClassfac As SwDMClassFactory
   
6. Dim vCustPropNameArr As Variant
   
7. Const SWDMLicenseKey = ""
   
8. 
   
9. 
   
10. Sub 打开文件()
    
11. Range("A3").Activate
    
12. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
    
13. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
    
14. Dim vCfgNameArr As Object
    
15. Dim vCfgName As Object
    
16. Dim swCfg As SwDMConfiguration '14
    
17. Dim nPropType As Long
    
18. Dim PropList() As String
    
19. ReDim PropList(0)
    
20. PropList(0) = ""
    
21. Dim intChoice As Integer
    
22. Dim FilePathName As String
    
23. Dim i As Integer
    
24. HeaderRow = 2
    
25. RowNumber = 3
    
26. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
    
27. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
    
28.     RowNumber = RowNumber + 1 '下一列
    
29.     PathName = Cells(RowNumber, 1)
    
30. Wend '回到>直到讀完路徑欄
    
31. Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
    
32. Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
    
33. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型
    
34. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
    
35. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型
    
36. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
    
37. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
    
38. If Cells(1, 1) = 1 Or Cells(1, 1) = 2 Or Cells(1, 1) = 3 Or Cells(1, 1) = 4 Or Cells(1, 1) = 5 Then
    
39.     Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
    
40. End If
    
41. If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
    
42. intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
    
43. 
    
44. If intChoice <> 0 Then '判斷有否點選檔案
    
45.     RowCount = 1
    
46.     swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
    
47.     For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
    
48.         FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
    
49.         FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
    
50.         FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
    
51.         FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
    
52.         If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
    
53.             Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
    
54.             Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
    
55.             RowCount = RowCount + 1
    
56.         End If
    
57.         If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
    
58.             Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
    
59.             If Not swDoc Is Nothing Then '排除無效檔案
    
60.                 Set swCfgMgr = swDoc.ConfigurationManager
    
61.                 swConfigNames = swCfgMgr.GetConfigurationNames
    
62.                
    
63.                 For Each swConfigName In swConfigNames
    
64.                     Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
    
65.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
    
66.                     If TypeName(vCustPropNameArr) = "String()" Then
    
67. 
    
68. 
    
69. 
    
70. 
    
71. 
    
72. 
    
73. 
    
74. 
    
75. 
    
76. 
    
77.                     End If
    
78.                     Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
    
79.                     Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
    
80.                     Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
    
81.                     Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)
    
82. 
    
83.                     RowCount = RowCount + 1
    
84.                 Next
    
85.                 swDoc.CloseDoc '關閉檔案
    
86.             End If '排除無效檔案<完>
    
87.         End If ''過濾器是2或4<完>
    
88.     Next i '逐一讀取所選檔案<完>
    
89. End If '判斷有否點選檔案<完>
    
90. End Sub
    

复制代码

xiaoxifeng

xiaoxifeng

sxl_sxl

xiaoxifeng

makejon

a8012024