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

ryouss

參考
$ b+ X$ s" e; Z+ H- R+ u9 X

: i8 F0 A- S) y; A2 X+ c9 M1 f

, k- y$ k+ a. S/ H/ O$ W3 z" b) x8 @- w

1. ' ************************************************************************************
   
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   4 E0 ^5 A/ D5 l3 r8 j! e' p
3. ' ************************************************************************************
   
4. 
   
5.     Dim swApp               As SldWorks.SldWorks
   6 b7 t7 \2 y9 K' d& }
6.     Dim swModel             As SldWorks.ModelDoc2
   1 P: s; |! I& w7 T. A7 x# ^
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   ( m( L& @5 @: h  A2 x7 z5 G% _, M
8.     Dim swConfig            As SldWorks.Configuration
   
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   % R- l% N/ I$ o9 N$ {$ _
10.     Dim nNbrProps           As Long
      _7 \7 ]& {  ]9 v+ Q
11.     Dim Part                As Object
    ! \+ \! s' i1 v9 |8 u1 s' {: C
12.     Dim Code_Name(2)        As String
    * b, v1 {0 g- |8 ~+ b9 G
13.     Dim valOut              As String
    
14.     Dim resolvedValOut      As String
    ) M& u% K; X4 U+ t% z* `
15.     Dim longstatus          As Long
    
16. 
    
17. 
    
18. Sub main()
    
19. 
    
20.     Set swApp = Application.SldWorks
    6 j) G3 L! ]+ f' K. |* E) \
21.     Set swModel = swApp.ActiveDoc
    0 ?& J- Q/ _& C0 \4 E0 k1 A1 o) o0 ^0 `
22.     Set swConfigMgr = swModel.ConfigurationManager
    + x' q  h2 d9 i0 Q8 R2 l1 K7 e
23.     Set swConfig = swConfigMgr.ActiveConfiguration
    
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    . \9 N0 h9 @, l3 {" p" Z8 ]
25.     ' Get the number of custom properties for this configuration
    
26.     nNbrProps = swCustPropMgr.Count
    
27.     vPropNames = swCustPropMgr.GetNames
    * u4 I0 w) S9 r8 s9 e' d
28.     For j = 0 To nNbrProps - 1
    4 c" R4 v) ?! {
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    8 B" _) l9 Q2 ~% N9 e1 q' t
30.         If vPropNames(j) = "代號" Then Code_Name(0) = valOut
    ' y0 j7 A; a5 [5 y; ]
31.         If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
    ( ]# I  r; `7 p2 ], c
32.     Next j
    
33.     'Debug.Print "    Name, type, and resolved value of custom property:  " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)
    
34.     Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    0 i! E: W4 N- D/ I
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
    
36.     Set Part = swApp.ActiveDoc
    6 ?6 b5 r0 t9 D) H7 w
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    
38. 
    5 s) y4 G+ I- U. s) b
39. End Sub
    # ?1 K# j8 N, W0 o9 X

复制代码

3 C% J' a' R5 g5 Y0 P/ P
9 I) Y8 E: @$ Q) F3 w1 h3 L9 h! _

xiatian11

+ \$ }6 G# g) m8 }
感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

阿帕奇

xiatian11 发表于 2018-10-31 10:39
2 S# k$ J0 V  j2 N" \感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

6 k9 M" a. Y* c2 F% y5 J3 }  _那是对山寨网防范的办法之一

阿帕奇

一直都视而见

hdgd501

谢谢楼主。好东东，值得分享。