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

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

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

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

x

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

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

Dim swDM As SwDMApplication
( n9 N5 B/ r( z
Dim swDoc As SwDMDocument12
" j! P M3 f* A
Dim mOpenErrors As SwDmDocumentOpenError
% N9 O& |) s+ G2 r" |! w- H
Dim swCfgMgr As SwDMConfigurationMgr
) p8 I. U. s7 T) W U
Dim objClassfac As SwDMClassFactory
& l& N( O& c9 E# C
Dim vCustPropNameArr As Variant" q, T" s4 j( W$ Z2 b1 w" ^+ i
Const SWDMLicenseKey = ""
3 G: ]7 N. h/ |0 c/ `9 o# F& H
2 r2 D4 k9 W: _0 M; O
7 l2 E; \. K9 G2 U1 i
Sub 打开文件()
: C& V$ Y/ ?$ J0 x R
Range("A3").Activate
+ L6 Y2 {# C8 K, a. q1 A# p
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")7 d' X- l0 N) Z4 f0 l
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM+ L/ l Q. h9 ?4 i- A
Dim vCfgNameArr As Object
" @% i6 k: L6 j7 K* N" r
Dim vCfgName As Object" Y9 F9 @- e$ e# k4 K1 J( J6 |
Dim swCfg As SwDMConfiguration '14! {" O) m. N+ s* e" n: O
Dim nPropType As Long3 n; a5 p4 p) ^: W) M
Dim PropList() As String; w1 ~+ i; p( z8 Q1 ?1 y+ ?
ReDim PropList(0)
7 Z3 f* I, w# Y4 S0 C: V! T2 K
PropList(0) = """ P/ n T1 G# u- J6 }0 F
Dim intChoice As Integer5 f m o" n0 q; J, }9 V5 l
Dim FilePathName As String& a) a1 f8 }0 l7 B1 y
Dim i As Integer3 f( ~- ~$ u) k5 `- y, c0 W" x3 H3 {
HeaderRow = 2; v0 Y7 a# s+ ` Z" b# _' h
RowNumber = 3
5 o6 i/ `! V6 g3 ~- B4 d7 z
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值& u: j2 q5 D4 f
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置), M" Y% b5 j0 C4 }* J" k
RowNumber = RowNumber + 1 '下一列
% _' a) v# }9 y2 y7 Y
PathName = Cells(RowNumber, 1)/ z4 O8 @$ Z. M7 ]& k' p
Wend '回到>直到讀完路徑欄 p$ z1 g9 e# }: q
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框, X5 e3 N+ P0 }5 _& s! e
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型/ J" i9 Z6 E, y# B7 x' w1 _6 y
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型
5 o2 j4 V# k/ @8 P8 W: G0 k
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型/ W4 D: A. m# ]6 s0 M4 }
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型0 g7 a* z& L) g. }9 M5 p1 b
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型) q- A' Q3 H8 v" G3 f1 X
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型, f9 P' a5 O( K* @0 A! s" m+ Q! h2 _
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
% H% c( G+ V& {- Y# y# e
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
9 v* q% ^9 \- |1 J
End If$ O, e+ v% o4 {0 y6 d0 t
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
1 A2 D: {5 C5 n) t2 A+ i
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
: v9 S/ M: a$ v: a4 m- p
1 n# F- i( M0 j2 V4 u
If intChoice <> 0 Then '判斷有否點選檔案, H7 D( B* u8 d) _4 g# _4 k+ a& i
RowCount = 1
1 g, ?+ m2 E8 X+ ~" U8 D# E' p. v
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
/ T2 V) g$ m/ k: ~4 ^
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
! b* P% Q1 F0 h/ G: G8 e. ]
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
+ @7 q, F! @/ v7 v
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
* V) W! h5 x) j$ p. a
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
/ P Y& z+ c/ u& T- U
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型, P R; J) C5 R3 G5 [* \) c
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then) u1 i" A1 O0 a2 A% |( R
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
& s! |1 s9 i; T8 G& x. U$ a3 C' ]5 G
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
' q+ p2 ?- F" p
RowCount = RowCount + 1
m& |9 r& F4 i5 `7 ~& s
End If! ~8 q) _8 y5 v8 H/ w3 ?1 p! n
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
- M; |) n4 q) F( l
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
! T$ p$ ` R4 z9 Z& K( \( e. W* p
If Not swDoc Is Nothing Then '排除無效檔案
/ Z; r9 q7 d' V' T5 `0 C7 j9 ^
Set swCfgMgr = swDoc.ConfigurationManager- x/ u1 _7 y2 Y. R E
swConfigNames = swCfgMgr.GetConfigurationNames
+ @, x# l7 ~/ o4 s
' `' i2 ]; U3 c0 {* J
For Each swConfigName In swConfigNames
" R5 m, X. @# O% h8 T6 R
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
, g, N& Z/ Y; ~& c/ m
vCustPropNameArr = swCfg.GetCustomPropertyNames
2 u# G& d$ i( E2 d! @6 C
If TypeName(vCustPropNameArr) = "String()" Then+ n& x6 {6 L5 s' k5 K6 \
2 x9 U" w$ ~* x0 J
* [4 P! e1 S8 K* L1 { N) \
- M* I/ P' s+ e* |6 a% R: O4 R
' e5 C+ j4 `+ |0 K; E
; r: u! @) j: Y6 W$ B
$ y }: R3 ?, B" ]
1 n( F7 F3 ?0 ~* S" k
' o. C; |+ P1 A, m* [5 r
5 ~' d% w7 [) n$ T9 e% Z
" G. B+ q& [6 K! B3 |
End If
' ~ M$ ~* ~9 e9 A5 I( @
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑 ~0 A' p6 G4 v% c( v" \" `6 Y
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
9 q/ i6 u& ~5 Q3 q2 t
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱! y* i* K, n, W3 y
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)' @0 ?, q- N5 q, r; w/ T
$ D5 H/ Y y$ {# ?% D% J Y
RowCount = RowCount + 1. v/ J; x! }( ^6 n4 ?
Next; t/ d2 G6 M2 c- O
swDoc.CloseDoc '關閉檔案
) y: E1 l) H7 P5 J, o$ }- d7 C n
End If '排除無效檔案<完>
8 Z: ]# e1 |. Y8 {! S1 X; C
End If ''過濾器是2或4<完>
( `2 M1 x0 j- N! r
Next i '逐一讀取所選檔案<完>
- j0 |( @( N& |$ V& k; h
End If '判斷有否點選檔案<完>
/ F1 H6 G, t' e' p$ m* l
End Sub
: z" n& E, L2 r# K

复制代码

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

通知

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

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

点评

浏览过的版块