关于批量修改零件属性的问题

xiaoxifeng

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

复制代码

上面这段代码，要怎么改才能不用启动SWDM，而是改为启动SW就可以执行呢？请高手帮我看看吧

莱虫

xiaoxifeng

莱虫

xiaoxifeng

332321665