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

ryouss

參考
: r; E0 W6 T# b- b' v
% e1 Y3 r4 z& J" ~1 a. o

4 F7 ~2 B% c3 G) g3 z0 |# b6 O

1. ' ************************************************************************************
   * A3 W9 B# l7 Q
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   3 F) ~2 g$ O- d( T6 O) @
3. ' ************************************************************************************
   * q" b4 C7 ^4 m5 a  o8 @
4. 
   : V+ K6 k9 i$ ^- I
5.     Dim swApp               As SldWorks.SldWorks
   
6.     Dim swModel             As SldWorks.ModelDoc2
   : }7 t7 Q8 F" `8 n
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   5 {$ b5 W2 k" t1 ]) g/ }' T6 e2 m; h
8.     Dim swConfig            As SldWorks.Configuration
   * \4 ^" E! f& `* r5 |; z
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   
10.     Dim nNbrProps           As Long
    & O. {; r, H% Z$ U4 L" h9 W
11.     Dim Part                As Object
    & m& e) M6 x4 S
12.     Dim Code_Name(2)        As String
    3 Y: j) P" U! c" S& c
13.     Dim valOut              As String
    
14.     Dim resolvedValOut      As String
    
15.     Dim longstatus          As Long
    
16. 
    4 A* b: O3 }' T0 f$ v+ d2 g$ P
17. 
    
18. Sub main()
    - {7 U2 A* x* F
19. 
    ) N: Z% a0 D0 }( w% t/ N: P# m4 B6 B
20.     Set swApp = Application.SldWorks
    7 [7 {" P' ?& M! H, f
21.     Set swModel = swApp.ActiveDoc
      r6 ?( J. r9 }; ^
22.     Set swConfigMgr = swModel.ConfigurationManager
    9 b5 K* d* K8 [: T
23.     Set swConfig = swConfigMgr.ActiveConfiguration
    ( _' g8 |6 [! u0 I$ C
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    
25.     ' Get the number of custom properties for this configuration
    - e0 r8 _  A: H& Z5 F( Z
26.     nNbrProps = swCustPropMgr.Count
    9 m! q# d! z5 V8 c! W" f2 d  U
27.     vPropNames = swCustPropMgr.GetNames
      t' x9 G4 l4 b' X( t+ R
28.     For j = 0 To nNbrProps - 1
    ; @. W2 v4 O: |0 N6 h/ B
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    # u3 X% ^9 c0 f3 a8 J
30.         If vPropNames(j) = "代號" Then Code_Name(0) = valOut
    
31.         If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
    0 S+ N) ]! F9 \  B
32.     Next j
      G! k# [! y8 H, U
33.     'Debug.Print "    Name, type, and resolved value of custom property:  " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)
    ( W( M; V2 E1 G9 j
34.     Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
    0 g$ t/ X0 q. {  ?7 c  b
36.     Set Part = swApp.ActiveDoc
    
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    
38. 
    - [4 |1 C# B8 b- L. V7 F) G/ d2 j
39. End Sub
    ' g+ `+ K4 T) S6 J4 G3 U

复制代码

1 A9 X! ?* l0 b% q2 o
8 T( U+ l, h( p! U3 ?

xiatian11

" @2 @3 m; S/ J( a) t感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

阿帕奇

xiatian11 发表于 2018-10-31 10:39
/ s( _3 m5 o# C  b7 M# N感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

4 X  ~4 H* P+ {2 b' O) F6 u2 s  C那是对山寨网防范的办法之一

阿帕奇

一直都视而见

hdgd501

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