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

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

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

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

x

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

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

Dim swDM As SwDMApplication
( K# _3 \) ^# Z1 {$ B) e, N
Dim swDoc As SwDMDocument12
4 q, E& B9 ^1 y& |6 P; h
Dim mOpenErrors As SwDmDocumentOpenError
3 R$ D6 S; m' J: O
Dim swCfgMgr As SwDMConfigurationMgr
. D5 C; T/ e- z4 Y
Dim objClassfac As SwDMClassFactory
8 x$ y+ y; A% a. P) O& d5 c, q
Dim vCustPropNameArr As Variant
0 n: S0 ]4 `5 C. y% D
Const SWDMLicenseKey = ""
$ L( l; t7 g$ U: l. e
( _$ A- R2 X/ k8 W8 c( Y
! B* i6 ^' E" |2 {# n0 j* v7 R
Sub 打开文件()8 r( o' D' V; Y% w1 e& h* p
Range("A3").Activate7 K1 C: i: F# i% x, u6 Z. b' |# y
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")9 V) ~8 |+ m4 e6 B! B+ h( _
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM
; e3 ^2 v9 w) n- G- \
Dim vCfgNameArr As Object
0 b1 r2 ^' A2 R+ E
Dim vCfgName As Object
. U# v6 F+ {; ], I3 X$ O& R7 m
Dim swCfg As SwDMConfiguration '14: {+ h# l3 {6 v- o' i" X2 d6 t7 p+ d
Dim nPropType As Long
9 D( R& c$ J# u7 L. _* v6 u
Dim PropList() As String9 b/ v6 a7 c) S. l
ReDim PropList(0) w& F6 ]! }' t# b2 j
PropList(0) = ""
; y5 w5 H) E2 R- ?. f' }% s
Dim intChoice As Integer( b' }- B4 U# r; Z* M) r1 g- r! s
Dim FilePathName As String
0 ]. M# b* d4 J5 }( }* p T6 ~
Dim i As Integer
, @" S( o7 q& w R% w7 |
HeaderRow = 2
! ^0 t) ?: J5 W o( u5 F9 @0 [
RowNumber = 3/ r& O, c/ h3 V7 v' n( X0 A
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
& f+ Y) w* p# r; V; ]6 p
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)/ }& B+ F, i+ e
RowNumber = RowNumber + 1 '下一列
" j1 K1 \0 I/ q: O" |' o2 Y8 l, q; r
PathName = Cells(RowNumber, 1)% Y8 y9 q( _! W5 {
Wend '回到>直到讀完路徑欄
9 S3 j F( s$ S/ Q/ n
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框& m2 m+ F/ ?9 ?) x1 @
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
4 k3 z, C# t8 G J$ w+ H
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型! a- O8 }6 Q1 E2 S
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型7 K* x, O {$ h; `
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型
1 V; y+ ?; `; n
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
' x1 s( k8 C6 Y0 V
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
" y- x( Z# Q, z" p+ \8 [: O
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; u9 r( x X4 B( u: B
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)0 x/ H; `- w$ r' U/ P. A% Q: R# t
End If4 [# D& _. N( y$ w
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)% c: S" Z4 ^/ m7 i5 K9 G. K
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框' ?) Z0 s( A- C
7 u8 Q- g9 ]" Q; d0 F% l
If intChoice <> 0 Then '判斷有否點選檔案
f& O' }5 e8 Q3 A8 P6 A% R
RowCount = 1
' F% t% d8 P; `9 \! R/ E8 ~
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
3 J4 j" } P+ J) ^: t
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
' H5 |. V$ L! N9 j* a. u9 t
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
: |/ R2 ]7 T7 B2 N3 Q3 `% [
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑; \* Y/ [2 a7 _/ v; o
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱+ ?& q3 [! x+ F% P$ v
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型) H3 v a5 a; q7 c; g4 O
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
& W/ D a+ p! [# t
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑; T' ^% h; [2 }; |$ b2 L
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
; d" C7 s. J. E& {3 p
RowCount = RowCount + 1$ G2 x" r% V1 R8 O, n6 c1 c6 }5 T$ G
End If
8 t! m; Y- i# D
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
3 B \# I2 B- {3 P
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
9 ^! ]- m8 r5 k4 C: b9 o9 b, S2 e
If Not swDoc Is Nothing Then '排除無效檔案" c+ S9 p$ z" K: q6 L
Set swCfgMgr = swDoc.ConfigurationManager
5 _% `: }7 A! ]1 J3 e
swConfigNames = swCfgMgr.GetConfigurationNames% K1 R2 _* [4 Z4 N% J6 A
$ V b4 ]( j3 U: |0 a) W
For Each swConfigName In swConfigNames
- U2 `1 I: }2 K) s& s1 }* G
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
7 B( \/ E- o$ F; B& o0 O( a" X
vCustPropNameArr = swCfg.GetCustomPropertyNames+ Z7 x* c# A! h5 q8 n
If TypeName(vCustPropNameArr) = "String()" Then2 \- ^# H0 G) c. Q# s0 h- @
; k6 z" [4 H, w; E* T& x% y# f- h
8 U8 r \) o" @& _7 I
$ C& G' A) r6 q0 ~
' Q+ o; ~. L) s+ d% S' J
. V+ B$ q% |: t" g! e8 w+ |
$ @! x- {0 j( P
8 W' x7 m; f+ J9 N
! e) F" _# y, Q
& n$ s5 K; ?, {; p! B! V
! U7 ?# e2 O# t! h! N
End If0 L3 k3 J9 k9 c* U6 {
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
3 o- |! k7 B/ s- [8 T1 ^
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱' A6 |' Z) x; T& o7 C
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
]: D/ L( }$ `1 a# u% ]
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)
, o/ ^7 e% S2 C! _* k) t) G0 A& }
/ l7 t5 p& R- S& @6 Z7 D
RowCount = RowCount + 1% K6 v3 L/ r3 P& c
Next
: K; n" _& U* A6 Y
swDoc.CloseDoc '關閉檔案7 o/ y" o/ _1 H4 l& F1 m! F& q
End If '排除無效檔案<完>3 L5 d- i J. W$ A* ^
End If ''過濾器是2或4<完>
4 Y& ^, k6 {" t# Q
Next i '逐一讀取所選檔案<完>
- }' l1 w3 z1 |( Z
End If '判斷有否點選檔案<完>" p2 y! q9 [+ b. X" X
End Sub5 U7 A0 j9 @, P

复制代码

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

全站		2005llnn 说: CAD几何作图竞赛题（2024年6月），至6月19日止	5天前
全站		goto3d 说: 版主微信号：caivin811031；还未入三维微信群的小伙伴，速度加	2022-07-04

通知

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

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

点评