依據(jù)配置特定屬性之"件號"及"名稱"存檔

ryouss · 發(fā)表于 2018-11-15 13:32:28

分享在他網(wǎng)的回覆

' ************************************************************************************
1 ]6 U2 J3 O! ?( b! |
' 依據(jù)配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
: g+ H @5 R. s- k; g* Y* B) B
' ************************************************************************************
) L' f ^! L. w/ X5 I6 C& s
7 R% X( p4 Y( d5 \' g2 T8 J% [8 {
Dim swApp As SldWorks.SldWorks8 _& a9 _( t4 {9 p5 D" T( E2 Q# E
Dim swModel As SldWorks.ModelDoc2- o& b3 M: b* p W+ {
Dim swConfigMgr As SldWorks.ConfigurationManager- l9 X _6 J9 h2 Z
Dim swConfig As SldWorks.Configuration
8 ^! {: O$ _1 p9 h4 G6 N9 V, M7 I; }
Dim swCustPropMgr As SldWorks.CustomPropertyManager) |# F8 T) {0 N/ N8 g( j6 b
Dim nNbrProps As Long! a% q% p0 V: \" h1 C# x; |+ e
Dim Part As Object/ O' \- W9 ]; H3 b
Dim Code_Name(2) As String
/ L& G& w! H% {0 [' A
Dim valOut As String' K+ U. k3 Y( r' u
Dim resolvedValOut As String
4 g6 Q; J1 b! x O" k2 j
Dim longstatus As Long* D0 a7 p0 O3 J7 U7 r
+ b2 d) Z* L' l; u; F
3 k' w$ I# a! l6 G) r
Sub main()
- O$ t _1 U: y
) A, h6 D8 s) A; m3 D' l+ g- i
Set swApp = Application.SldWorks0 w2 g$ F: ^; r; G4 _) N
Set swModel = swApp.ActiveDoc
' ]% B+ j |9 f
Set swConfigMgr = swModel.ConfigurationManager
3 B: u3 o; L* J, h: ?! x% I( X4 g
Set swConfig = swConfigMgr.ActiveConfiguration' Q" q+ U0 h* R+ I
Set swCustPropMgr = swConfig.CustomPropertyManager
" y# D0 E9 X6 X8 n
' Get the number of custom properties for this configuration* s* h! W: ^ s6 [+ X
nNbrProps = swCustPropMgr.Count
$ v: k- u! k0 E
vPropNames = swCustPropMgr.GetNames
8 m% n) Q6 g2 z$ T4 ~( d# q+ u
For j = 0 To nNbrProps - 1
+ m% j( L) b/ C
swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
7 o m* v0 ~% P; R
If vPropNames(j) = "代號" Then Code_Name(0) = valOut" d$ x- ?, b! ^3 q5 ~- X
If vPropNames(j) = "名稱" Then Code_Name(1) = valOut3 E K+ {! v$ W [* n- Y$ e, N6 m' p
Next j- N: n4 j+ Z3 w" K5 _, k
'Debug.Print " Name, type, and resolved value of custom property: " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)* w- Q. _$ G, w! G; f7 n; |! H9 @+ u
Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴(kuò)展名",不管擴(kuò)展名是否隱藏$ V+ M# x+ ~6 K5 L- a6 ]
Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑8 T( Q5 n* m0 b! Q, j2 M
Set Part = swApp.ActiveDoc1 Y1 b/ o4 ?! {& C( g! }
longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據(jù)配置屬性"件號"及"名稱"存檔
- L/ \0 y/ p3 G1 M- l" E
i* F' r' L& r3 Y
End Sub
8 A3 N% X g7 X! r