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

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

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

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

x

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

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

Dim swDM As SwDMApplication
2 X k; _4 _6 I
Dim swDoc As SwDMDocument12
+ l- q7 y" j* D3 B
Dim mOpenErrors As SwDmDocumentOpenError b. R: ]1 s9 Z- |- y Y
Dim swCfgMgr As SwDMConfigurationMgr
1 z e8 C1 o6 a! E( M0 T4 y# t
Dim objClassfac As SwDMClassFactory. N, r. U% n% J- ~$ Z+ _1 q
Dim vCustPropNameArr As Variant) n! t* X& P$ n) @" ~) Z; c0 H
Const SWDMLicenseKey = ""7 y; O8 W% M- \, V; Q# J) H
/ g, ?) [; D' D ?
6 c0 \) c8 |# i7 h) {
Sub 打开文件()
' W: e7 u j' u6 \, ^5 `7 U! O
Range("A3").Activate
9 F1 f4 A* R# B/ K- q8 r% g; a7 B
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")% W' Y: z' |% X3 S& y0 o6 F, _1 O
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM U, [% I- [( l) I/ a; ]( D9 \
Dim vCfgNameArr As Object
6 {! T b0 s+ P: b
Dim vCfgName As Object+ [7 T) e+ |3 H; ?- _
Dim swCfg As SwDMConfiguration '14% H& V& x+ a. V$ R
Dim nPropType As Long1 a6 F3 {# _$ S. y
Dim PropList() As String
5 o0 w X: V9 b" Z6 D! g: O
ReDim PropList(0)7 f$ y; C9 x' _
PropList(0) = ""
( @6 W7 U3 ]1 R( v' U. A! x* Q) u
Dim intChoice As Integer
# R9 B$ H& ^& H; g
Dim FilePathName As String& i. h! O# k. X: `9 q
Dim i As Integer
; b+ E4 h. L N3 s4 D1 U9 q
HeaderRow = 2
' l4 A! r7 u0 ^2 H% Y
RowNumber = 3
% U# s: H9 U% K; e+ [/ m
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
2 n* o6 A) C/ O. ~1 v( [$ t4 X# s
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置), g& D: U q0 s* f
RowNumber = RowNumber + 1 '下一列9 Z1 F) V2 ]# _+ e5 `
PathName = Cells(RowNumber, 1)
: Q8 L* }9 w4 J/ a4 z
Wend '回到>直到讀完路徑欄
0 `- C0 U! _( k* Y
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框$ ^( [0 ^ o+ _+ H/ w
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
# v! n1 i: H/ p) k6 h
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型* [9 e+ n4 N. g# D
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型
3 L2 V. L; e- e2 p1 n. |& K
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型3 }8 l3 c+ C* S! {$ S5 K( M
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
* c( v1 s/ G+ Y4 K
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型; g) `5 f+ J- }
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
- b! B$ j) s8 B6 Z$ i& }
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
4 [* B5 g/ t! N9 U
End If, K" @9 s; i( G% x V) b0 O" K8 o" a& W
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
. L, s8 M! e1 L4 K" w# L
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框# ~) c7 K) l: f: o9 |
/ u3 s2 k' ]+ |2 x' t
If intChoice <> 0 Then '判斷有否點選檔案
0 L; M/ o5 ~, s+ S3 m
RowCount = 12 C& J' D+ E7 j; ? s
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex7 C# W. J4 q4 l2 S, ?3 ]
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案4 ~8 T$ u* J. \$ G8 {
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱" U4 e' ~7 ~- k
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
~1 a/ m. |( T8 c: V* B
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱. D# C# g1 O3 S9 L$ ~
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型
7 Z" I( m/ f9 i' d W# u9 M
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
6 h( ^7 X' R3 F( `" w
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑1 `) z* @9 L* j6 N+ L0 `
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱# o2 r# Y9 W4 j) |5 W7 j
RowCount = RowCount + 1+ j, W2 N! L: j: H4 n$ E5 C
End If
# C+ T7 c: h* \" f( U3 K/ w7 J
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4% A2 O) s0 D" c% w
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案% {: z, D# A" J* H9 j
If Not swDoc Is Nothing Then '排除無效檔案' t8 V* e( ^" k! r, l
Set swCfgMgr = swDoc.ConfigurationManager# E) Q6 |4 Y/ \; i+ X% k
swConfigNames = swCfgMgr.GetConfigurationNames
, s# c2 @# m- G9 m1 p6 s' k
8 u$ {& _# i6 w0 S+ A
For Each swConfigName In swConfigNames
; x# Y8 y {$ X* Q7 p7 X3 l" I
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)
. [ q6 g/ A0 ]( o
vCustPropNameArr = swCfg.GetCustomPropertyNames
3 m! c: I/ o6 Y( z1 w" X
If TypeName(vCustPropNameArr) = "String()" Then
& k& P0 v% Y% \7 i
8 x- X I e) f. R1 n% u
9 D: b+ R0 K- ^0 \, ^) U
; k5 q4 `7 Q! H! ?' s
- P9 }2 d$ x, o: m$ ~) `
6 X* F; w9 C2 N9 |% ?# z
- _% \! R9 v9 \- w% e: n
' r- k% L+ K" g! e
, _+ k- ]2 u& }0 z) J$ S3 \7 I+ A
# Q7 Y5 y6 c" C7 f+ M; p# k3 r
" `' Z* E M2 o0 h: Q* n8 H2 [
End If
0 h0 K/ ?! h, {0 Z% x4 n# T+ R0 R
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
! v3 t0 N3 P6 r( G. Y1 p
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱- M* V1 }+ }5 s, A" t. `
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱7 I. N7 f2 l7 ^' h3 l
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)
) t. g D2 p- @9 K4 V
2 o9 m1 \- Y2 x" p- _6 ~/ l
RowCount = RowCount + 10 z! U( q& `- N! v
Next
" ~ K$ Q6 K- D
swDoc.CloseDoc '關閉檔案5 K- Z$ z9 h J8 d! R
End If '排除無效檔案<完>
$ t. ]# Y0 y# N* E" J/ }
End If ''過濾器是2或4<完>5 X% b! t2 n4 Z2 F: e/ g
Next i '逐一讀取所選檔案<完>
! @1 W+ W4 J& O# U
End If '判斷有否點選檔案<完>; P+ r- B* C6 L
End Sub3 S1 ?/ E9 X: T6 s( g. i

复制代码

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

通知

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

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

点评

浏览过的版块