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

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

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

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

x

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

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

Dim swDM As SwDMApplication1 h4 V) E8 Y& X9 ^
Dim swDoc As SwDMDocument12
3 J" d; v2 ^4 m, u# Q9 L% F6 z
Dim mOpenErrors As SwDmDocumentOpenError- A0 h7 E: \$ t8 ]/ R& p2 P- C2 u7 W
Dim swCfgMgr As SwDMConfigurationMgr
' _) D7 l, O& z4 P
Dim objClassfac As SwDMClassFactory
+ A5 a/ V J$ W. G7 l( ]2 w8 L
Dim vCustPropNameArr As Variant
7 s* s" ]7 K7 i- a
Const SWDMLicenseKey = ""* E8 \/ B5 e3 g: Q/ B
; _" E% H" c- T
i. g, G; q5 @8 v
Sub 打开文件()' ^2 \3 ?& s( N0 A8 {1 D5 V
Range("A3").Activate+ N/ Z! p3 x( {$ D5 U+ b- u
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")) L. X& ^: e. x) R$ b0 V' K
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
& r5 v# s( `! n
Dim vCfgNameArr As Object
" }, {) p, d0 X9 O; w: X
Dim vCfgName As Object4 `! P. t" n o* j! f4 S
Dim swCfg As SwDMConfiguration '14' Q" O5 A/ J( R1 [! \
Dim nPropType As Long/ N( @4 r& l, g) g/ |* L
Dim PropList() As String
& [# } t# W3 p+ S
ReDim PropList(0)4 s3 l) {9 _. N9 [7 _
PropList(0) = ""0 Z4 N, a1 ^- m0 F4 n* y
Dim intChoice As Integer, }2 S$ g/ a" @ J6 `- A
Dim FilePathName As String. J! h$ p$ ?" N8 ]% v. W2 a
Dim i As Integer; B: c! k Q; D" G
HeaderRow = 2/ |( C# x U: r) f( ^9 C: b
RowNumber = 3
1 ^) {& W+ h! C& [9 e2 K8 P
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值$ ]# z$ b" P3 r+ L6 x5 A, @; O8 g
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
$ ]! O0 Z( A3 F
RowNumber = RowNumber + 1 '下一列
6 V" ^: q# k& y! l- W3 K Q) z4 `
PathName = Cells(RowNumber, 1)
, k B# N) @ J0 B/ M! a
Wend '回到>直到讀完路徑欄
& s& U! o6 _' W% z6 L1 e# {' U
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
) C$ _+ t1 A7 |8 t& |
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型. r: Q4 n' P9 E4 N
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型! d$ g3 u u" t! S7 C& q8 y
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
+ Z+ z$ p- @0 i. K: _2 {
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型& Q D& G0 D9 \% m
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
2 _# [: e9 Q) d* W
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
1 M0 t' @" c, R/ S
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
" m) m9 C2 J$ P' i
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
+ I$ N) y, i2 x4 S, Q7 E' i
End If# \2 G; b" [2 V' ]- M7 x
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
9 c' Z1 d- d2 c3 p, v' X
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框& U; g9 M: G! w4 y8 L
1 E; B: P' j0 w- z
If intChoice <> 0 Then '判斷有否點選檔案
2 j4 ?; Q4 Q. I/ I. C- n' `- b* u
RowCount = 1
4 j: K! \9 s6 P: ^1 u: M) C% }9 q
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
4 ]6 k% J' K/ ^' O! |3 I
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
* p( i1 z* q$ @6 a0 M3 J! x
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
7 F; S) o8 a# L/ a: t; Z
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑0 i7 n$ h( q8 R9 s8 [! ?
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱- i) F: ~5 P" ~- P$ U- ~% x
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
8 V- R. Q- {6 s6 F w
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
- d! \- a8 i( W* r
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
8 o/ O6 ?1 j9 r" L8 l( i* V7 N
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
0 s3 p# v4 h5 v
RowCount = RowCount + 1
9 ^) @& w! Z4 g8 O9 I
End If. n4 F8 W3 q' L2 S! g5 \$ P% \
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4 v' X7 }- A/ @; A) V
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案0 j- X# \9 t6 H* p- Y+ a
If Not swDoc Is Nothing Then '排除無效檔案
' N4 }- w5 T8 q/ _6 N- v
Set swCfgMgr = swDoc.ConfigurationManager4 m8 n. @. x$ _0 P
swConfigNames = swCfgMgr.GetConfigurationNames! {7 S+ r3 u- i- ]. q# p0 v
+ E. G' O) m# C2 d/ E& I* i
For Each swConfigName In swConfigNames
9 \. L( c# U+ K6 ]
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)) v* d/ o0 F$ u3 I. v# k
vCustPropNameArr = swCfg.GetCustomPropertyNames7 ^5 ]: K8 k4 Q! D
If TypeName(vCustPropNameArr) = "String()" Then
, n, e; N) N6 ^) X @4 p
3 I1 Y5 ^) A8 p7 V J4 R
8 q. g7 @( a% r `/ \, j+ b/ `
" l9 s: T; P0 H* i
# k3 x: \: F N: x
/ {2 Y1 F. `4 `3 c# _1 o
& T5 l; ~0 _& _2 L
s: Q) b3 L6 f- Q
2 Y; x% |$ f5 @% @3 v" U/ U. |
/ E4 x4 k% z4 M$ w( s+ C
$ G9 H- T! k" B
End If
7 \ ?% W0 w' x- _; n% {) `/ q
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
5 }8 Q' E4 p( b( }! z! |4 x
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱; }2 \- M# z3 K* E& d8 g
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱$ D, N9 [4 H. B5 |! [' M/ C$ [+ j
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)/ p4 q! V: e& I- [5 v
6 ^) e8 ^" ]0 z' i8 }% c
RowCount = RowCount + 1
& j- G, x- D0 ]- e6 U0 E
Next( u5 R/ n1 A% M: b U" [2 k' e" F
swDoc.CloseDoc '關閉檔案" l% ?" P. k5 X; X! X
End If '排除無效檔案<完>6 Q1 V2 }4 j' _/ o! ]
End If ''過濾器是2或4<完># o& j1 [' l8 V7 x& G4 \
Next i '逐一讀取所選檔案<完>% Q: l& v/ h" z
End If '判斷有否點選檔案<完>! u/ c, X+ c3 d
End Sub$ T* k8 q1 k: j. V

复制代码

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

通知

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

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

点评

浏览过的版块