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

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

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

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

x

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

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

Dim swDM As SwDMApplication c0 W' y( t2 A, B+ s
Dim swDoc As SwDMDocument12
V2 ?& @! [4 }3 E2 ?" ?& o
Dim mOpenErrors As SwDmDocumentOpenError
2 O) X& r( b9 q6 W! p5 A" M
Dim swCfgMgr As SwDMConfigurationMgr& Y3 ^ E6 r6 ~/ `2 m8 j( w
Dim objClassfac As SwDMClassFactory+ s' q2 t8 q3 r4 s$ b) `
Dim vCustPropNameArr As Variant
8 V% I. r; L3 i( c6 Z2 l2 H
Const SWDMLicenseKey = ""
^8 ~+ i, }( W4 E
' f% ^: t: v, p0 [, m( |
( h! ]6 P5 _4 P
Sub 打开文件()
, G7 y! s0 { U/ f$ n
Range("A3").Activate
. _1 k1 T* u( K" @2 J
Set objClassfac = CreateObject("SwDocumentMgr.SwDMClassFactory")% D; j+ k x5 ^! Z
Set swDM = objClassfac.GetApplication(SWDMLicenseKey) '啟動SWDM$ j3 U$ I8 ?" w0 `
Dim vCfgNameArr As Object
$ v! Y3 X$ U9 M( f2 f
Dim vCfgName As Object
$ ~. O4 f& u3 i- C J
Dim swCfg As SwDMConfiguration '14
) |( ^2 d# y% P0 O2 X7 }+ B
Dim nPropType As Long7 T; J9 Z) e+ S/ O, V% c' D3 q$ w! J
Dim PropList() As String
' E5 U( m5 `7 ?: n# B9 B
ReDim PropList(0)* E) O: z; I6 f* E
PropList(0) = ""% {9 u, Y1 c7 {0 P5 ^ K$ Y
Dim intChoice As Integer6 w& k* E2 `: q4 o) _
Dim FilePathName As String
; t$ @% q9 e" l7 b) M! r
Dim i As Integer0 z, ~' X$ \5 M9 [" q4 |$ ^
HeaderRow = 2
5 v/ |$ v* U8 U% L
RowNumber = 3
( k1 I- p$ B# q$ V! q. W& ~& g( i0 I1 t
PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
, O K6 y& ]2 ?
While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)7 o3 t/ u+ A/ {% ^% K0 F, H
RowNumber = RowNumber + 1 '下一列
2 M; [' r' [0 A. \
PathName = Cells(RowNumber, 1)" ]% S$ X2 U9 ^# A/ I
Wend '回到>直到讀完路徑欄
: X h' k! B x* R0 d6 R5 q
Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True '設定為多選對話框
6 o& q+ e! d+ R% y( c& Q1 c3 O
Application.FileDialog(msoFileDialogFilePicker).Filters.Clear '清除既有類型' a6 o. A, B6 t0 A& h% m T: c& v
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件自定义属性", "*.SLDPRT" '設定檔案類型% G! X' P! A/ a- @/ U- P; S
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "零件配置属性", "*.SLDPRT" '設定檔案類型+ H3 U2 f$ k" T0 A# {* A' H
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体自定义属性", "*.SLDASM" '設定檔案類型) J( ]6 [. r, V6 X0 Z* o$ {- @
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "装配体配置属性", "*.SLDASM" '設定檔案類型
/ l* N4 B! a r
Application.FileDialog(msoFileDialogFilePicker).Filters.Add "工程图属性", "*.SLDDRW" '設定檔案類型
0 M4 O& R' P6 N8 c1 {3 N
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& u+ P. g' L( g% a
Application.FileDialog(msoFileDialogFilePicker).FilterIndex = Cells(1, 1); \: s% @! }9 R% p
End If
" d5 _3 B2 I# s) T! q: I
If Cells(1, 2) <> "" Then Application.FileDialog(msoFileDialogFilePicker).InitialFileName = Cells(1, 2)
3 A) [! H+ T2 c/ h
intChoice = Application.FileDialog(msoFileDialogFilePicker).Show '彈出對話框
/ L9 ^& c; K% }
7 O8 M) v6 n* [
If intChoice <> 0 Then '判斷有否點選檔案
7 e, i, b2 A& X% Z! S
RowCount = 1. {( P- t+ M) O, ?( g8 N7 C4 S
swFilterIndex = Application.FileDialog(msoFileDialogFilePicker).FilterIndex
' H. ?( Y1 \9 z6 v- C. [2 L
For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count '逐一讀取所選檔案
$ G/ p1 u; I: M! k% L. o" _0 W5 T) {
FilePathName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i) '讀取完整檔案名稱: K& I* k( K0 H* ^
FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路徑
# J/ g8 m, G9 p: e4 e V! t
FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解檔案名稱8 k; J8 L" n* T
FileExtname = UCase(Right(FilePathName, 6)) '分解檔案類型3 s. ?+ |, d/ r* I; r: y
If swFilterIndex = 1 Or swFilterIndex = 3 Or swFilterIndex = 5 Then
& ]6 Y' r- r* O' k! S# X, W s6 [3 [
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
! r) K: i$ s: [* O$ ]; L
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
+ H$ f: q1 E% _4 r" `
RowCount = RowCount + 1' d, ?2 w& I7 g; w
End If
' f; m) v; c6 }& p ^% p
If swFilterIndex = 2 Or swFilterIndex = 4 Then '過濾器是2或4
* ?" ~0 [8 L$ X9 v
Set swDoc = swDM.GetDocument(PathName & FileName, swFileTYpe, False, mOpenErrors) '開啟檔案
/ `1 r9 d) B% ?7 H! f
If Not swDoc Is Nothing Then '排除無效檔案
: x; t# F/ ?6 \' g6 y
Set swCfgMgr = swDoc.ConfigurationManager& ` {# t4 x0 d, D5 y2 H3 K
swConfigNames = swCfgMgr.GetConfigurationNames1 Z6 c, y7 P# O5 @2 [, d" ?/ W" A
/ X a- F+ y! d- ~7 O) w8 T9 l
For Each swConfigName In swConfigNames
4 ~2 D: U% L+ _+ {
Set swCfg = swCfgMgr.GetConfigurationByName(swConfigName). A7 [4 L: T. F9 V
vCustPropNameArr = swCfg.GetCustomPropertyNames6 r' _6 d! H$ `9 H1 u( }2 J, a
If TypeName(vCustPropNameArr) = "String()" Then6 H+ w9 e8 P$ O# Y7 P% k* w
+ L- O; w9 S5 H. K+ N1 G
2 j* V9 W, V: T) R, G3 J' X0 W
. y6 k I& F# W. {2 t% I+ v
* K, H' _4 a" p, g2 }+ R0 B: X
* X0 Y4 D* U2 B( U
+ \2 M9 T1 c' z, b4 ]
/ K# ~' D, s: J3 X
1 n8 I0 c& b3 O( Z# ?, o% }3 Y
, v6 |/ d' p' A. \, @& l
- I: G3 P; B1 s1 F* ~
End If6 V, \7 y' @7 q+ u2 G; P
Cells(RowCount + RowNumber - 1, 1) = FilePath '填寫路徑
8 ~! L% ]5 `' R" e0 Q: ^3 w+ F
Cells(RowCount + RowNumber - 1, 2) = FileName '填寫檔案名稱
1 e% }7 q8 L% D
Cells(RowCount + RowNumber - 1, 3) = swConfigName '填寫模型組態名稱& g% B! v7 I- C3 n/ s1 U
Cells(RowCount + RowNumber - 1, 3).Interior.Color = RGB(200, 200, 200). ]% w f/ @! {, U& T) F+ q$ ^
J4 r8 f: F, S* m
RowCount = RowCount + 1
$ b6 i1 [; c. D! U7 N
Next& J6 }( i3 P: z, _& q, ~
swDoc.CloseDoc '關閉檔案
' v/ q. D# C. w" M: s1 J
End If '排除無效檔案<完>& N+ S: R/ r" y, I& v( j* r
End If ''過濾器是2或4<完>7 Y) _0 j ]0 D3 ^
Next i '逐一讀取所選檔案<完>! X! I: H" Z# Q1 K
End If '判斷有否點選檔案<完>
) v3 b0 a) C5 i/ z* N
End Sub% u( X0 B' p) A4 M8 d

复制代码

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

通知

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

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

点评

浏览过的版块