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

ryouss

7 U) _# d; b6 @7 R分享在他網的回覆

' m+ W9 i; `5 P6 H" \1 _1 C; n

1. ' ************************************************************************************
   
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   5 }! B9 i- G2 @
3. ' ************************************************************************************
   
4. 
   
5.     Dim swApp               As SldWorks.SldWorks
   & H: P" S, m6 x2 k+ c" P/ R
6.     Dim swModel             As SldWorks.ModelDoc2
   . p) X( H. s1 G2 t2 M+ B* p# w
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   - T/ }3 i' m# ^5 d& `
8.     Dim swConfig            As SldWorks.Configuration
   
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   5 t8 X# B& i2 Y
10.     Dim nNbrProps           As Long
    
11.     Dim Part                As Object
    : a5 Q5 A# ~( H0 `4 W8 F% v
12.     Dim Code_Name(2)        As String
    
13.     Dim valOut              As String
    
14.     Dim resolvedValOut      As String
    
15.     Dim longstatus          As Long
    2 S8 r& t( u9 X* Q4 i
16. 
    
17. 
    ' E' k: }& M. T$ _0 H
18. Sub main()
    
19. 
    
20.     Set swApp = Application.SldWorks
    
21.     Set swModel = swApp.ActiveDoc
    
22.     Set swConfigMgr = swModel.ConfigurationManager
    $ ?; n8 c! W7 Z% [# e
23.     Set swConfig = swConfigMgr.ActiveConfiguration
    1 }" V- A/ B, B$ ?' j
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    8 B) m5 q9 W! e+ G: r
25.     ' Get the number of custom properties for this configuration
    8 P/ F7 k5 G) a' O, i/ F$ w
26.     nNbrProps = swCustPropMgr.Count
    5 i% ]1 l" |) @
27.     vPropNames = swCustPropMgr.GetNames
    4 \1 N5 M- r* x" B4 p6 }
28.     For j = 0 To nNbrProps - 1
    
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    
30.         If vPropNames(j) = "代號" Then Code_Name(0) = valOut
    2 S! n" K3 B; p: B! }1 ~: b
31.         If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
    
32.     Next j
    
33.     'Debug.Print "    Name, type, and resolved value of custom property:  " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)
    * ~2 b+ Y! C; K) ?7 X: U: l
34.     Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
    
36.     Set Part = swApp.ActiveDoc
    1 q# H1 T0 Z) E& T3 m4 e; {
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    
38. 
    " ^& a  s- L9 ]$ f& d: q
39. End Sub
    

复制代码

zx65606

图号分离？

ryouss

zx65606 发表于 2018-11-15 16:15
图号分离？

: b( [8 A+ @2 V8 O1 B非也!如主題名稱.
) n* d6 X/ d  \. W
2 ~. O/ u4 l& J" u' n% q& R+ q

远祥

这个动态图楼主用什么软件截取的，求教一下！！

ryouss

远祥 发表于 2018-11-16 22:06
这个动态图楼主用什么软件截取的，求教一下！！

' s" ?% K+ e( @( [. hCamtasia Studio 8.0 软件截取的
0 Y7 e7 p5 B* b1 ^