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

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

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

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

x

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

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

Dim swDM As SwDMApplication2 n; O3 S( {+ A& C& I
Dim swDoc As SwDMDocument12
' S- W2 G) Z* V8 m1 y) X" R
Dim mOpenErrors As SwDmDocumentOpenError
- Y6 {% z" f' D# `% L
Dim swCfgMgr As SwDMConfigurationMgr: Z. t$ A8 b8 L
Dim objClassfac As SwDMClassFactory& O! i( F8 n) x3 s& l$ n( [2 L/ Y
Dim vCustPropNameArr As Variant
! p5 s r% p' }+ \5 W, C6 E" w3 _! x
Const SWDMLicenseKey = ""
2 K+ o2 o7 W0 { c) q
$ ~0 L# ], Z: @6 v8 L
8 A+ G7 T2 H# h. w: u: [/ s6 a/ b3 L
Sub 打开文件()
' V' v+ \) V7 u# v
Range("A3").Activate' v/ a! K+ I/ H5 S+ C& ?2 C9 D
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")
' c* Z: M3 `: @7 L3 L: U
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM) n" q. C, I/ p- |
Dim vCfgNameArr As Object
& B1 F0 o$ k! @6 Q4 }
Dim vCfgName As Object# u( d' e& t: s* T4 e0 W
Dim swCfg As SwDMConfiguration '14" t9 e! B. n5 Z1 z" ^0 ^
Dim nPropType As Long
# _( K1 w" }9 K
Dim PropList() As String& |0 M2 F) V! Q' [/ G
ReDim PropList(0), e- u1 S9 i; M; e( @, `# S
PropList(0) = ""' K* Q* v" W1 U7 o! o
Dim intChoice As Integer, A, G2 R$ R: l5 _* z
Dim FilePathName As String4 i# u2 Y1 T- V$ ^
Dim i As Integer
5 w# N# {' a1 D! p+ H& T/ q
HeaderRow = 2; X- s( F$ q4 a# ]/ P
RowNumber = 3 o7 y d! E& Y% u0 I2 X
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值 c q3 ]; x {
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置). X# J: q( \1 \; p6 u1 e
RowNumber = RowNumber + 1 '下一列9 j, L. l% I- J! O
PathName = Cells(RowNumber, 1)
) D- a0 g- c9 p4 ]
Wend '回到>直到讀完路徑欄
" w; W% B I! E& y q* f- |, Q
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
' Z+ T7 K; L) d+ G! t. u0 i% K
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型
& C! e5 s0 h- w# C8 O' w, J% V
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型/ c0 Z a- X. V# Q# _
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型& e% g1 c5 a! x3 l) H+ f9 K
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型
: `- {: r8 M. s4 Y! e1 ]
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型: k9 ~) [3 |4 y, L- S
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
8 r1 m7 P: I. \" p% @, ? h0 p
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
1 S( ]: a& P! `8 d( n& [8 N
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1)
5 R0 C7 v# N( {! |
End If
& q& B) Q y1 M3 r* Z# }
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)' a" O" }! [5 f% L2 d8 w
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
4 W9 @+ f0 _8 _8 _1 N8 Y# q% m
% g8 s" C5 S. C) x# A: l
If intChoice <> 0 Then '判斷有否點選檔案3 @8 i* j% i: C* f% j
RowCount = 1
, Q! t0 p3 ] E) m- H
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex+ D/ V: r( x8 C
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案* u2 D; ], @" v$ c0 c0 p0 |* t+ x
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱
]# b4 U B! K
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑. ]$ Y: p4 g! l# S6 J0 ]
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱
6 B) g5 H# I' p3 {& a+ d( e
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型4 S5 j5 Z1 ?; o9 _% h; [; @0 P
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then/ {( p. S* s9 {) P# J0 I4 T
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑, P5 K& n* N6 Y
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
& P0 c2 S @1 z5 C5 j X) j
RowCount = RowCount + 1
7 ]7 l: G( n; B- Q9 y }0 i* m
End If# q# M- v ~. |* M9 j$ l
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
& O" d# L7 f6 F$ Y% _. L* L
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
5 y- F; P6 j N
If Not swDoc Is Nothing Then '排除無效檔案
- U0 o( K) E4 d: w2 v
Set swCfgMgr = swDoc.ConfigurationManager
$ \) I+ S, C, t8 x1 k0 }( [
swConfigNames = swCfgMgr.GetConfigurationNames
4 X5 J0 g5 u( S$ f
$ t! f5 D/ N0 I: Q k' F
For Each swConfigName In swConfigNames
' J; _ I/ w# f9 B% O
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName)# @2 n2 Q( t# ^1 Z- q* k
vCustPropNameArr = swCfg.GetCustomPropertyNames
% T' x" G7 T2 Z Y
If TypeName(vCustPropNameArr) = "String()" Then
( o, l( ^# M# e% { `* S0 i
1 G9 ^7 ?9 Y( j5 w I. u
5 y6 N9 S9 | \4 K! q
" p4 p" {) E$ X; i' n% `
% F0 I" q1 |$ G
( H; k( r1 K* B8 R3 C3 l
7 F9 k5 P l/ p$ n) @2 w# ]
6 {4 M5 w# z( K3 B; E% y2 g
. w# F& r6 y8 o* |8 g
W, P( j: i6 k/ I _# r
" M f4 j* P; f6 A7 S
End If
; r3 q$ ^3 \, `
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑: t! I$ E" j- w. e( e d
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
5 J/ l; G* a8 d6 L1 Y
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱5 }* p8 j( b. e6 e: C0 t
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200)8 | h1 }" X8 l8 x3 [1 g# k
$ } W0 a2 p/ c7 p# Z% a3 ^) k, ?! x
RowCount = RowCount + 1
! @" \* Q! d9 B
Next$ C- Y3 s) b3 @4 A; E
swDoc.CloseDoc '關閉檔案6 y; m" A, M0 v ^( A
End If '排除無效檔案<完>0 |6 v; P1 b8 t3 X" o& \( u
End If ''過濾器是2或4<完>) l* C' Q' ?0 o3 S3 Y8 k) E
Next i '逐一讀取所選檔案<完>" O5 T2 V9 W- l5 D
End If '判斷有否點選檔案<完>
# q2 H: s5 T$ H d9 [
End Sub
' I3 I) t' R9 q; \+ r

复制代码

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

通知

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

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

点评

浏览过的版块