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

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

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

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

x

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

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

Dim swDM As SwDMApplication
" C6 T% l4 b- l& h1 N0 O
Dim swDoc As SwDMDocument12
5 A; Y8 @9 S! F v
Dim mOpenErrors As SwDmDocumentOpenError
8 U0 K5 {( N- u& V( b; R" e# ]
Dim swCfgMgr As SwDMConfigurationMgr9 V2 L# D( m: H* u9 o
Dim objClassfac As SwDMClassFactory
/ o- [$ x8 u7 C% M
Dim vCustPropNameArr As Variant
" Y s3 j: `2 r. T1 U7 Q
Const SWDMLicenseKey = ""
! `2 ~+ b* c, V( k) p
- T. C. y' h* A9 n; j
. D/ v( C: L5 O1 s4 L# V! I; e, F
Sub 打开文件()
" N! r" M0 |' x& q
Range("A3").Activate$ q3 ^$ T5 g! d+ S; s
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")- M' ]# T( U2 [# Q% t! L
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM/ d. U- o' u0 R' p' R
Dim vCfgNameArr As Object
: ]# g! g) t: H0 h# Z, y/ F8 o
Dim vCfgName As Object l7 X) o% r+ I" u. X
Dim swCfg As SwDMConfiguration '14$ p3 K6 O+ m5 T! t
Dim nPropType As Long
, M( d3 ?1 \/ T, Z5 E0 R
Dim PropList() As String0 c7 L! _: r0 Q
ReDim PropList(0)
4 T2 Z- {& l4 w# J% }7 d/ L
PropList(0) = ""+ a* m" ^+ o$ N
Dim intChoice As Integer, [1 k& P6 @% o$ H- S$ E9 ^5 z
Dim FilePathName As String; u; e4 ~9 \) p$ h+ V* g6 m: u! I
Dim i As Integer
3 Z6 p/ Z* C E* ?
HeaderRow = 2
& m# F8 z! I# h$ B- G2 k" ?) O
RowNumber = 3
- T" W* u3 v4 ^
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
0 z/ N* u# `9 I$ O1 b. }" B
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
1 L/ _3 ]* Q' P/ R$ ?3 J; o2 E H
RowNumber = RowNumber + 1 '下一列; ?0 |+ h) \ A7 Q) z
PathName = Cells(RowNumber, 1)2 X6 v; M W8 m5 E; D# h8 Z: ^: t
Wend '回到>直到讀完路徑欄$ B6 u; `! e" h) G& Z1 d% Z* m
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
" L8 D' \" x$ G
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
% }2 s5 B2 y; a% T$ h0 U
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型
6 b. `) {1 g$ k
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
- n+ s, X6 |$ y; a
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型
) m3 I5 k- O. `8 u# u
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型3 f8 J# K9 r* S8 w% Z3 N
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型1 n! W- V6 A( F$ [$ a9 y$ 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; p0 S- J0 g9 h. q. \% p
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)+ C0 }3 U: I( V! w1 E9 g
End If( u {/ E. `6 c0 h# X: P
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
' W# D, @* G0 n& l& K0 O& {4 S
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
% o: W U1 Z, |6 h; D1 [
2 k" }# l+ f2 y
If intChoice <> 0 Then '判斷有否點選檔案7 k2 I( I8 k& ]( P; Y( }- }
RowCount = 11 o# Q$ {, M4 v& s
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
t& P3 \& g+ ^
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案: a) R1 Y/ L1 s _/ u3 h6 V6 C2 s, l
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱; R. x( h3 G0 z% Y0 V7 d8 V1 D
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
+ i B, G4 Y; {$ S
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱* S" b; U# J3 J( V$ T
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
) L! X/ R/ ~4 i) L s3 P: A
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then& A6 B8 y# d# Y G) D: P$ {9 U
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑2 j2 _7 _! A0 Y/ v. A
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
. V# b4 e$ K- e8 F) w- c0 C
RowCount = RowCount + 1
6 B. X' \. Q% A! m5 ]5 z' L
End If, k5 H6 m3 R: z. b
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
5 C6 `; t% L$ P+ f9 z6 W) {
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
$ m9 X) I9 W% m( Y
If Not swDoc Is Nothing Then '排除無效檔案0 j7 \- w" `- L0 H6 Z
Set swCfgMgr = swDoc.ConfigurationManager4 k% \, E' e3 [4 v7 l
swConfigNames = swCfgMgr.GetConfigurationNames) b" O' P$ b5 u- O9 ?. c) B& I
0 q$ O0 e1 E1 G" f/ d& o( c. L
For Each swConfigName In swConfigNames: C6 r! B2 p j7 \- k
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
& m) i: X O1 U" J A
vCustPropNameArr = swCfg.GetCustomPropertyNames7 C8 ]/ n9 w& Q) V! R @
If TypeName(vCustPropNameArr) = "String()" Then
: J F) F5 _( s8 s, f' ~6 J
0 W* x. k2 v* G2 D+ d. j4 ^
, R5 t, l h9 ?1 ^ M
7 H' b5 r; T" D3 _3 U
2 Z2 k) k5 W+ y5 F0 v
& { R4 T, I) B! m3 G
5 j9 W4 r6 @1 V' R1 R4 g2 K
9 P% N j: L. c9 h9 B
! b! ?5 ?7 }8 z c t
$ \) [$ V* W* r
5 X$ z3 `* @4 r3 ? O$ X
End If6 P- B) T5 y6 U3 G3 ~ H
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑4 A+ x2 p }1 d$ m I5 ?. V) [# U
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
7 p1 `" [- h" E) {
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
) o8 w4 R6 S. c/ l4 x
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200). t$ X# c# Q1 D7 g! D1 q2 t, h( d; B
" ?* a# C9 F; |. }- Q. N
RowCount = RowCount + 1
& v" x% ~# P9 j
Next, F+ V) N% ~) b2 p
swDoc.CloseDoc '關閉檔案; r# n# c2 z: Q2 X2 o q
End If '排除無效檔案<完>
/ l a) s: k' X& n' n' t; H
End If ''過濾器是2或4<完>
" \2 y5 A% Y7 y2 _7 e- x
Next i '逐一讀取所選檔案<完>
$ N2 K, h- \$ k( Q0 U
End If '判斷有否點選檔案<完>' L: m: f- h5 {& k
End Sub
* Q# L" d, ~6 I( k/ |

复制代码

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

通知

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

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

点评

浏览过的版块