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

xiaoxifeng

/ Q. ~+ M5 P1 e现在的问题是 ：在下面的代码的空白处加什么代码。可以达到图片的效果。就是在打开装配体的时候，自动遍历装配下的零件和数量 并自动缩进
4 Y" @1 g# i6 z; q5 X


- a, h# f0 N1 G" j5 @
, {: |+ v! x, q4 a

1. Dim swDM As SwDMApplication
   
2. Dim swDoc As SwDMDocument12
   $ m: ]  {- T0 \& W5 ^$ M. h) W7 ?
3. Dim mOpenErrors As SwDmDocumentOpenError
   ! d4 G! l, ~5 K6 @
4. Dim swCfgMgr As SwDMConfigurationMgr
   ' X8 J' [2 P. X; I2 A8 F
5. Dim objClassfac As SwDMClassFactory
   & g4 a- w, p8 e( T' v$ }
6. Dim vCustPropNameArr As Variant
   
7. Const SWDMLicenseKey = ""
   
8. 
   
9. 
   
10. Sub 打开文件()
    & ~5 G$ l0 i, T) W! R( D& f6 P* _
11. Range("A3").Activate
      {* e% Z" o+ d5 {% F, h; }
12. Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
    9 ~4 O' ^, o$ D4 `
13. Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
    
14. Dim vCfgNameArr As Object
    ! m/ |1 Y& v. M) p' P
15. Dim vCfgName As Object
    5 O2 L! h  w' |' @
16. Dim swCfg As SwDMConfiguration '14
    
17. Dim nPropType As Long
    9 b  z' ^  a$ z: u% a
18. Dim PropList() As String
    & {) p: ?4 u9 |( ~+ w
19. ReDim PropList(0)
    4 G- r& V/ [) ?$ E# c) Y; F
20. PropList(0) = ""
      d5 V+ }/ c6 S3 m
21. Dim intChoice As Integer
    
22. Dim FilePathName As String
    
23. Dim i As Integer
    
24. HeaderRow = 2
    
25. RowNumber = 3
    ; t2 n6 P5 M1 x0 W
26. PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
    
27. While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
    - X9 R8 e" h  `! O
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" '設定檔案類型
    1 k, G$ ]& d' ^# L2 S
35. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型
    " ~5 t: N% t  m$ O$ A
36. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
    
37. Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
    5 o$ u" G. E" D
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
    . w# @9 P/ W' i5 q, D
39.     Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
    
40. End If
    3 ]! A+ z" W" h8 Q
41. If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
    - f  F! N. V3 l9 y" R
42. intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
    
43. 
    
44. If intChoice <> 0 Then '判斷有否點選檔案
    0 h+ P! `' |& H9 {/ M: H  Y( ^6 E; O$ ]4 t
45.     RowCount = 1
    6 e! C* G$ q6 B2 u. B& u2 `4 @* b
46.     swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
    0 \: c+ ~* L2 D' j
47.     For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
    
48.         FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
    # y% y) V) n! q& K8 q  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
    2 x1 W; k0 p) U' }/ H) f
53.             Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
    8 R/ |! b2 U  I; v
54.             Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
    9 C4 B, }5 M: L' u2 c& g: `
55.             RowCount = RowCount + 1
    & r" A" t; I4 D% G3 I7 C
56.         End If
    1 o2 Z& d: v. w1 U5 }& H
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 '排除無效檔案
    7 W+ w; j1 X6 p- F  ~- p5 s
60.                 Set swCfgMgr = swDoc.ConfigurationManager
    , r6 C" ]! ~" A3 W/ H8 L- e1 `3 y
61.                 swConfigNames = swCfgMgr.GetConfigurationNames
    0 a: W; n; E; W9 D: }
62.                
    
63.                 For Each swConfigName In swConfigNames
    
64.                     Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
    + V) x4 _7 U+ h3 c+ ~+ \( I8 Q
65.                     vCustPropNameArr = swCfg.GetCustomPropertyNames
    
66.                     If TypeName(vCustPropNameArr) = "String()" Then
    
67. 
    + T0 P! C- U- C
68. 
    6 n. k; x* F- r) l- u' J4 K
69. 
    , o7 ~: a9 Y" M9 m  b) M
70. 
    
71. 
    
72. 
    $ l) U  S5 ^6 {  K) g6 a2 N+ ?8 _( w( S
73. 
    1 S+ ]- U- k7 ]( ^0 d& y
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. 
    % R7 @" J- d4 h# \- B! Y. U4 i
83.                     RowCount = RowCount + 1
    / v2 S7 D- T  u4 d9 g/ T, }4 _2 P+ B
84.                 Next
    % L7 d* n* [) k, y
85.                 swDoc.CloseDoc '關閉檔案
    
86.             End If '排除無效檔案<完>
    
87.         End If ''過濾器是2或4<完>
    % ]$ |4 K* P  G) u$ n
88.     Next i '逐一讀取所選檔案<完>
    9 p6 `) r" k2 }: t2 s$ x* u2 h! k
89. End If '判斷有否點選檔案<完>
    ' W( ]) f; ?% x: [- a3 G8 J
90. End Sub
    

复制代码

) G; t* l+ T7 K  ^! G' T9 q. |