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

ryouss · 發表于 2018-11-15 13:32:28

分享在他網的回覆

' ************************************************************************************0 |( z1 F* V8 i! B0 Z* p6 Y0 V: L6 s, Y
' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
2 t" ^/ q6 }, Z/ u3 M5 o/ x
' ************************************************************************************9 C, o1 F+ K' y+ w( @' D0 Y
1 Y, \+ y. E% {
Dim swApp As SldWorks.SldWorks
* Z5 z( n+ W7 b8 w4 I+ x: }' ?1 P
Dim swModel As SldWorks.ModelDoc2
9 X* H& o, J* {3 i- X* X
Dim swConfigMgr As SldWorks.ConfigurationManager9 e( {8 q% R$ p8 f
Dim swConfig As SldWorks.Configuration
& u c# Q6 {3 p- @6 w, j2 U
Dim swCustPropMgr As SldWorks.CustomPropertyManager) Y: E; m! ^- S' \
Dim nNbrProps As Long
Dim Part As Object' ?- e8 b2 S' U" k' q( J
Dim Code_Name(2) As String
6 |2 E3 e) r- j! H- X* K4 M
Dim valOut As String5 n$ K# [) W" b1 c: I% @
Dim resolvedValOut As String
; |! S E3 L. T
Dim longstatus As Long
7 a* C- C6 S; s3 F3 ~2 @6 ^
4 P9 ~9 d6 \5 [/ d/ R: D
& T. y/ A- h" c
Sub main()
+ W+ R4 q' f0 D
$ R0 `! L. [; \' y7 J* }
Set swApp = Application.SldWorks$ h; T* i; Q5 s7 g9 D& I: x
Set swModel = swApp.ActiveDoc
" w, ?; G; _3 U/ S- U% j
Set swConfigMgr = swModel.ConfigurationManager
% q' |, L9 a& k- j' w& b/ x5 L( }
Set swConfig = swConfigMgr.ActiveConfiguration8 O: _ m- ~: ^' ]- f t9 Y
Set swCustPropMgr = swConfig.CustomPropertyManager7 c5 C4 a9 O, c8 C* ]2 Z) y
' Get the number of custom properties for this configuration$ ~6 N" S- V7 Y8 H
nNbrProps = swCustPropMgr.Count& I* h; D1 l _5 Q4 t; k8 _7 S
vPropNames = swCustPropMgr.GetNames' K1 Q$ g* d! [* E# u
For j = 0 To nNbrProps - 1
# \" e! V! p- B- Q) E' _7 c
swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut/ @. K+ K& a1 K; J' I( p
If vPropNames(j) = "代號" Then Code_Name(0) = valOut% k! |) C8 \# M) [
If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
, O" n3 f, \4 K. n
Next j
5 k& T) f( ^7 w7 H1 \1 B. k2 J
'Debug.Print " Name, type, and resolved value of custom property: " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)
2 ^! a& ?& a5 x! A2 a
Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
6 b! t! J8 M" G: l+ g
Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑# H0 o; a7 |4 \- r8 b9 V) L
Set Part = swApp.ActiveDoc# }& j# A }& N4 D; H1 E# K
longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔% ?$ a" p8 \3 c# S, k
- x# p, i. O# a' u3 r
End Sub
& S5 v' a5 ?* L; G: i0 i