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

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

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

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

x

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

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

Dim swDM As SwDMApplication
6 p6 U5 @& m' F9 k3 C8 k! D
Dim swDoc As SwDMDocument12
! k& Q$ `, u6 L' G, |9 V1 T
Dim mOpenErrors As SwDmDocumentOpenError
# c4 U4 i% h3 a) v
Dim swCfgMgr As SwDMConfigurationMgr+ z% N5 H3 Q. M" v6 J) `
Dim objClassfac As SwDMClassFactory
0 C& H5 `- A% G+ ?3 L, z& g ~
Dim vCustPropNameArr As Variant& T4 B! u/ n2 t4 H8 A9 z
Const SWDMLicenseKey = ""3 d. I8 M; i4 n$ V4 I# G
! s+ r& {, \, V- I! b& f
6 x! Y2 [# h, [/ G& u
Sub 打开文件()
7 ^: |. A9 S) h+ I: k) c
Range("A3").Activate
" Q0 q4 E! i8 N
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")' l* a4 s; l% j
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM: P1 |: R" s* D1 X4 F- h z
Dim vCfgNameArr As Object( i+ V+ W5 G D( o5 Z" w$ s
Dim vCfgName As Object
- \% I: W# a9 ]1 D0 A
Dim swCfg As SwDMConfiguration '14! I: R" I" E8 g" r2 {
Dim nPropType As Long
, j1 H2 f: C# D5 I9 B
Dim PropList() As String& _3 }1 i- m# {; I S
ReDim PropList(0)
6 h+ U4 O' T" h) K
PropList(0) = ""
# R' J9 w) ]" X! n4 P6 v, ]
Dim intChoice As Integer9 V$ A8 ?& `/ B9 a/ Z. J* V0 G: r6 D
Dim FilePathName As String/ L) T5 [# t# f
Dim i As Integer
/ [. k% U3 W, A- D) H& ^# f
HeaderRow = 2
3 @# I" Z' r/ F6 \5 R. t
RowNumber = 3
% K( V( f- v$ E( H3 m; A# Q8 [
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值$ J6 @7 C% w3 l9 p- T& X6 l" E: R
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)/ _# v2 L- @5 L+ j6 q) _
RowNumber = RowNumber + 1 '下一列
/ R, H0 L! K; O8 c1 K
PathName = Cells(RowNumber, 1)
& Z/ R7 O4 _) T' \+ U! R8 V- p
Wend '回到>直到讀完路徑欄
9 J& n1 A, E! J0 H& U1 N
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框# \# d6 R' Y3 \, c# g
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型5 O: K- t* P/ e0 I
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型0 ~3 N+ y( e9 {3 G1 `: [3 ]9 |
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
+ J9 @. Q. D# q u7 s* `
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型* m: b. e, G& v5 e4 {, W
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
2 p9 L! w* y. I
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型8 }. Y# Q- |( T6 c2 E
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' Y6 y6 M! J9 m
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
- M- h! Y M6 N% c1 j( o
End If& y/ k# c, h$ v5 |
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
! Q4 l5 @; w) D, F
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框9 o6 `* D; u) D
/ I% X1 H% m# u f
If intChoice <> 0 Then '判斷有否點選檔案
# e4 B. }/ ?1 v( q
RowCount = 1
0 L: g+ E$ L2 y& y+ o9 `- j
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex4 i( D. l8 D; @8 o
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案, ? C) x k8 o' k x% C, A
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
( \4 s$ D2 F' R- }) N4 `1 @, X
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱& O: w/ |, {, o/ N' @
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型3 B4 J( B3 f% ~ D
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
3 x6 S0 r+ F. u
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑) s- t5 K! z' z: c# k) [4 w
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
0 U2 j @( R0 \$ e. G
RowCount = RowCount + 1
" v5 C2 @5 V9 W
End If
3 I8 ?3 p# |: |
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4! }$ D3 f; k- c" h
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案) i! w, a" L3 @( U
If Not swDoc Is Nothing Then '排除無效檔案7 O5 R/ I |. d9 u
Set swCfgMgr = swDoc.ConfigurationManager
2 t# H A5 G$ M! o- b
swConfigNames = swCfgMgr.GetConfigurationNames0 `! `5 m' N4 _: p; @. _1 Q
% v) F0 l7 { b5 V4 b/ \% J
For Each swConfigName In swConfigNames
. o6 J; V) ?. h3 H/ t$ x1 t- g3 U
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)! e# i1 l; u0 Q& n( D7 |
vCustPropNameArr = swCfg.GetCustomPropertyNames) ?# x- K9 ]' h
If TypeName(vCustPropNameArr) = "String()" Then
; U8 t/ {7 w, s6 e6 P
. H$ t/ D* ?) o9 i) S
- n! W$ L: j O3 W. `5 @
' U( q6 G' K* [; p) Y& o
{4 O8 A% C1 h6 A, N1 {! o5 H4 Q
2 y) F P" ]) Y* h1 k
5 T- s' L; K0 S% {& q6 T7 k
; B( S& V g4 F+ Y! H. }6 B
# v h( I& P& A. L/ x1 `: h. o7 N
* \6 F U+ a! U
1 c- t: u# B% Y. V6 I3 ?& ?/ I
End If1 }: W6 x( P" F) J) A& w3 ^6 g# r
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
% D, M# l0 Q) n" h2 q+ V1 @8 u
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
: U8 q5 z+ r/ {( J) q7 N
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱
0 y0 y# a- P3 U
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)) `1 d4 U" d2 a5 f# j [
* f0 k4 i) X: B) c
RowCount = RowCount + 1
$ `7 i. R& N+ I7 r4 G
Next! [1 J3 \# b5 c0 U% S
swDoc.CloseDoc '關閉檔案
( c" }; w6 Z r2 c* `
End If '排除無效檔案<完>0 D9 ^& R( p3 K2 |* \" h
End If ''過濾器是2或4<完>
8 o1 Q9 E: c) t( K, o+ d( F
Next i '逐一讀取所選檔案<完>
& C% _0 @1 R y' X1 R0 F
End If '判斷有否點選檔案<完>/ F7 B `/ n$ @' y( @" R/ W
End Sub- _4 X" G" t+ i; V

复制代码

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

通知

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

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

点评

浏览过的版块