依據配置特定屬性之"件號"及"名稱"存檔 - 机械必威体育网址 - Powered by Discuz!

' ************************************************************************************
( c+ t/ X/ I; U+ |
' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
: B; l6 }" `9 d
' ************************************************************************************- F+ Q O* G/ C9 G7 A
+ y" `$ h! S5 q4 l0 _" n
Dim swApp As SldWorks.SldWorks# ^! ]& d) u2 B
Dim swModel As SldWorks.ModelDoc24 o$ `1 H/ Z* V R
Dim swConfigMgr As SldWorks.ConfigurationManager
+ w; A) e8 D f& b5 o) R2 i& z: l
Dim swConfig As SldWorks.Configuration" d% k6 J: {& r7 }# b) q
Dim swCustPropMgr As SldWorks.CustomPropertyManager
& H) U. H* c, M; K3 m
Dim nNbrProps As Long: N$ i8 E# @. P% s. t7 R) t
Dim Part As Object1 K$ O: C/ Q1 [1 p6 L
Dim Code_Name(2) As String: f! K, d" Q" c) J$ b
Dim valOut As String- H6 d( A& q$ U' c: j
Dim resolvedValOut As String/ {; T" n+ O& t/ V0 r& @
Dim longstatus As Long. {4 b9 z/ r e+ F
$ }9 u) e) {* V" ^$ p: o: z
) s0 H4 U) t1 S( s& f$ c+ ~
Sub main()4 ~: o" `: D: k2 C# u' j8 w5 n
& ^: R. {/ O, u3 m* m+ j
Set swApp = Application.SldWorks7 A, B$ i& w6 d6 L a8 I, F7 u
Set swModel = swApp.ActiveDoc
% {- |# Y1 H7 S W' u) q/ t
Set swConfigMgr = swModel.ConfigurationManager9 G+ {: n7 g k$ [
Set swConfig = swConfigMgr.ActiveConfiguration' x- n( i2 R" a& T$ T5 W! o% _
Set swCustPropMgr = swConfig.CustomPropertyManager
' U! J+ c" H4 c
' Get the number of custom properties for this configuration, n5 `6 h6 C( ]/ S' f
nNbrProps = swCustPropMgr.Count
9 U0 s; y* K3 j! V/ `' z1 Y* g
vPropNames = swCustPropMgr.GetNames
5 A% a3 \& u0 J& Z' t; _8 ~) J
For j = 0 To nNbrProps - 1
! ~5 y* }" O8 E* g% P0 `% W
swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut4 e& I0 h7 V' n: j& X2 x
If vPropNames(j) = "代號" Then Code_Name(0) = valOut
' ~& i4 ]$ q9 Y8 ^
If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
4 h* ?! \, ^- E7 `2 f
Next j
$ F" ]: d- O0 Z$ L
'Debug.Print " Name, type, and resolved value of custom property: " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1); s( u8 [* }' Z' ~3 Z# l. Z d
Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
. {0 _% u5 |' u* G! W% W9 |0 w
Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
6 R" a( d8 e; x) K0 x
Set Part = swApp.ActiveDoc* s k( I$ G! o/ g& B0 w
longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
V2 j. A8 A( k& u
8 a O3 ^4 K: z8 ?; t
End Sub
7 D3 m7 W: T5 f( k" y1 P

复制代码