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

xiaoxifeng · 发表于 2017-3-30 15:18:45

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

本帖最后由 xiaoxifeng 于 2017-3-30 15:19 编辑

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

Dim swDM As SwDMApplication& a( N1 h+ F+ Z' s- ]3 m
Dim swDoc As SwDMDocument12
' ^! {( j4 S! p0 ]8 N9 Y: }. r" p
Dim mOpenErrors As SwDmDocumentOpenError
, L, R3 T6 @5 q" r% s5 L& L
Dim swCfgMgr As SwDMConfigurationMgr
% g2 c. [- }) b" i; u& c* L
Dim objClassfac As SwDMClassFactory
( p8 b3 d7 R+ r0 X5 Z4 O6 a
Dim vCustPropNameArr As Variant
% o1 e u8 `0 A
Const SWDMLicenseKey = ""1 x( H" M" C# k z
3 @5 b3 Z6 C3 L$ J* D8 k
' f0 X5 c9 [1 C( `* Y
Sub 打开文件()& u g3 a' {0 g6 M1 L. i% y) E8 T. `$ q
Range("A3").Activate) s( Z1 Q; F+ s- q# j
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")" G P2 a3 T1 b2 _
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM9 m0 A1 ~2 b% v9 ^5 r8 p
Dim vCfgNameArr As Object& }' X. m' G$ u) Y5 G
Dim vCfgName As Object! S$ m! x9 `/ G! y% ~
Dim swCfg As SwDMConfiguration '14
1 y6 J9 O# M0 q
Dim nPropType As Long
) h' x! {. e c, m3 L( C- |5 s
Dim PropList() As String
5 z8 b2 T# e$ Y' `0 }2 O
ReDim PropList(0)) k2 k3 D1 D/ g$ l
PropList(0) = ""9 U# m! i! x4 {# g0 \( W
Dim intChoice As Integer
* Z, u& n: p7 w) O" G" k1 ?% R
Dim FilePathName As String
8 }) z6 r# p8 R; ]- R0 s) A$ J1 ?" P, |
Dim i As Integer2 `4 ?5 w+ A) s0 @
HeaderRow = 2
2 N& B# N6 J2 b: {' P
RowNumber = 3
. N6 ^5 n: |$ @3 R5 \
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值3 M6 P* I z; K8 t2 H& u
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
- M; X; n4 V2 j
RowNumber = RowNumber + 1 '下一列
[0 q/ W7 B1 M! N0 l& p5 C
PathName = Cells(RowNumber, 1). l4 J+ ` A$ ^7 ] u5 ]
Wend '回到>直到讀完路徑欄
# d Q* {, B3 Q/ t" M* p7 l
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框* i% g9 h3 ~, s1 [$ ` B
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型3 h4 y4 i0 O3 C! r; I* X6 [8 P
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型' n; @5 h: f2 M. D/ T
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
) ?8 l+ ^$ I. I, @ _
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型: f. P/ W" P* K6 {' o6 [* Z
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型5 L" y7 `% C7 d9 C" M& V( c4 U- o. R
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
* ~& c5 m6 \1 w, p/ ~0 g! t
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% C" `2 X" P4 i: ] y$ ]
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
, _; H: h; P4 @' \# \; [
End If' ], f }3 {; d3 N9 m( y3 n: l" x
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)* p1 l! h) h: Q! a) b/ B2 {
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框2 c* x1 r# o- {4 [ F/ g
+ |7 Y8 _0 `" R& r. u( ~7 `/ ?
If intChoice <> 0 Then '判斷有否點選檔案! h$ F; B2 j0 a
RowCount = 1
4 v8 E) _: L$ Z6 |1 M7 P3 E
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
: E# _& `( R5 n& p! C$ u
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案1 J0 p6 I- w: A2 M: r
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
8 n6 y7 W W% H: n/ d5 E( R0 z) o
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
4 q( A& T7 |$ Y
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱8 t# R) ^6 i: |6 }
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型0 L5 b0 x) z4 x+ v% a$ k" H; B
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
+ k ]7 J9 K3 [; k
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑4 ~1 s" k6 ]1 m# K- m
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱+ V7 y0 m& v G2 @* @: ~! X7 z5 c
RowCount = RowCount + 1
2 g( A! }) D+ B$ N, D- d" F
End If% B% O- d) C; M, [/ y
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或46 f2 q- ?0 E7 q5 W' Y( u
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
" F [5 |) G0 E3 A2 o
If Not swDoc Is Nothing Then '排除無效檔案% h& I9 b2 t& s2 `- b: h D% y
Set swCfgMgr = swDoc.ConfigurationManager" D( u/ v1 A- P* K% d# |; A2 k
swConfigNames = swCfgMgr.GetConfigurationNames5 A+ [& |" U" r5 s
$ a1 H9 h, z7 P9 J
For Each swConfigName In swConfigNames8 j2 X, v8 P, o2 a
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)& q& l' ^. R; b5 ^8 n, |4 A
vCustPropNameArr = swCfg.GetCustomPropertyNames
5 A, i* Q3 M1 b
If TypeName(vCustPropNameArr) = "String()" Then, j8 K8 F4 K7 e% Z' _: c6 w: f
) U2 o/ M8 E& j. O" B5 J
. E+ A' a& M7 K# V3 r3 G( G
, H# ?/ R- i5 U3 L
) y: [, E+ c2 f( b/ p
' h: i7 \2 l/ w; u" p) ]/ v
) m5 @, F0 V1 Q) H) Q( t
' _4 L" n ?. k
( A3 k# i/ D3 T( f, h k
0 G' h/ b6 p: I+ k
& r K; P3 [* _
End If
5 l+ S: u8 F1 c( {' ?- F1 D& {* c
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑7 Z+ w: t* q2 t' Y) g
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱1 i7 l. a" D0 A" T+ V
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱2 X: V. J1 x8 f3 d0 u$ I) Y. j4 E
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)6 Z# M0 l9 S! w8 m! M6 h! Y+ i, B
% g/ `6 O/ n. J7 e
RowCount = RowCount + 1
! B H( V( o: u; ^! @2 l
Next7 Z8 Z& p) }1 k+ ~* q7 x
swDoc.CloseDoc '關閉檔案
( Q/ j& n: c- [. d6 r
End If '排除無效檔案<完>1 y2 V6 ^6 s! y4 e
End If ''過濾器是2或4<完>
$ c. Q1 k% Z8 c V( \# i* Q- k
Next i '逐一讀取所選檔案<完>
) t8 U4 q, D4 H7 b: x* Z
End If '判斷有否點選檔案<完>
M r& i% e* e `! K6 R3 @! j
End Sub$ y( a0 \5 e* A

复制代码

		自动登录	找回密码
密码			注册

通知

[讨论] excel VBA 批量更改solidworks 属性的问题

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

点评

浏览过的版块