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

ryouss

1 i* Q$ ?; }$ d" i9 o3 d參考
, s# F- u- s3 ]3 M

" G8 C' V$ g* |% }# C7 Y

1. ' ************************************************************************************
   
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   . d' l" b3 c7 c" Y# X
3. ' ************************************************************************************
   
4. 
   ' ^& ^" J1 Z! {4 N; o* G% B
5.     Dim swApp               As SldWorks.SldWorks
   
6.     Dim swModel             As SldWorks.ModelDoc2
   0 F9 u) m- H0 B8 d) L3 K7 q
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   ) ?, @, G. n5 K1 ?; s; k
8.     Dim swConfig            As SldWorks.Configuration
   5 C- ]5 w" J$ J! m- n
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   
10.     Dim nNbrProps           As Long
    
11.     Dim Part                As Object
    
12.     Dim Code_Name(2)        As String
    - P+ b$ ]- @: e6 s
13.     Dim valOut              As String
    ; A" h1 v+ v& `9 Z" z
14.     Dim resolvedValOut      As String
    . o6 \6 @! x$ a: R* n& i
15.     Dim longstatus          As Long
    
16. 
    + q% I1 k' p6 b5 H9 V
17. 
    
18. Sub main()
    
19. 
    - S- s) W8 H% ~
20.     Set swApp = Application.SldWorks
    8 c4 M3 T4 e* V8 u
21.     Set swModel = swApp.ActiveDoc
    / a4 y; g- G, j; J( M
22.     Set swConfigMgr = swModel.ConfigurationManager
    
23.     Set swConfig = swConfigMgr.ActiveConfiguration
    
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    : m2 ]& n" G: I) [0 U/ ?/ }) ]
25.     ' Get the number of custom properties for this configuration
    ) [4 Y7 I7 g1 F  q( s; L, }
26.     nNbrProps = swCustPropMgr.Count
    ; S: O- x" ^2 i* a4 y
27.     vPropNames = swCustPropMgr.GetNames
    * `2 U% I' U2 n5 J- D
28.     For j = 0 To nNbrProps - 1
    3 `1 s) q  K0 J  W
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    + z* r& I3 P/ ~% f  b% l% ?$ b0 i0 j
30.         If vPropNames(j) = "代號" Then Code_Name(0) = valOut
    
31.         If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
    4 P0 v; s0 t/ f, E( u: }5 O% ^, S
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 '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    # x; b5 [2 M5 x( u6 y4 b! }
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
    + B+ P1 p, n9 z
36.     Set Part = swApp.ActiveDoc
    6 ]4 F  L4 p( W: v0 K6 G, u, [- m  r- b
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    8 m9 L' D9 {$ F5 P* b( N0 f
38. 
    
39. End Sub
    ( U  _4 ~, a2 h; `3 e8 g2 _7 t

复制代码

; s: S  q$ J/ q9 s

xiatian11

7 C4 A' r; B* D; Y  x
$ [1 D  W, m1 y9 |感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

阿帕奇

xiatian11 发表于 2018-10-31 10:39
. i5 ]7 q' g$ h+ ?感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

那是对山寨网防范的办法之一

阿帕奇

一直都视而见

hdgd501

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