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

ryouss

分享在他網的回覆
& c5 S" A/ Y; H" V, o: T3 [8 f

) {6 W" g# r% {% f' a3 J

4 I% h  @) \7 h# z8 `8 ^

1. ' ************************************************************************************
   $ |" M6 ^7 ]# R% J% L
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   / k9 a. p9 j0 I2 z# B* V9 E5 S
3. ' ************************************************************************************
   
4. 
   0 }& u$ n- U, M
5.     Dim swApp               As SldWorks.SldWorks
   - r5 ^8 S( y, ]) M/ A
6.     Dim swModel             As SldWorks.ModelDoc2
   
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   # F  R) L* g6 Z6 c/ G* N
8.     Dim swConfig            As SldWorks.Configuration
   
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   
10.     Dim nNbrProps           As Long
    , V- y0 S+ l( j. j1 m
11.     Dim Part                As Object
    
12.     Dim Code_Name(2)        As String
    & W' y/ G  ^6 i3 h# S: R
13.     Dim valOut              As String
    
14.     Dim resolvedValOut      As String
    
15.     Dim longstatus          As Long
    : I* [0 H& D0 h& x
16. 
    6 P/ M1 x% M$ k: h
17. 
    
18. Sub main()
    
19. 
    
20.     Set swApp = Application.SldWorks
    7 u/ h9 L% @( I
21.     Set swModel = swApp.ActiveDoc
    
22.     Set swConfigMgr = swModel.ConfigurationManager
    8 P4 {) |7 B# |' k
23.     Set swConfig = swConfigMgr.ActiveConfiguration
    1 a7 V: C$ p7 U$ @& v
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    
25.     ' Get the number of custom properties for this configuration
    
26.     nNbrProps = swCustPropMgr.Count
    
27.     vPropNames = swCustPropMgr.GetNames
    
28.     For j = 0 To nNbrProps - 1
    
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    
30.         If vPropNames(j) = "代號" Then Code_Name(0) = valOut
    
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)
    + q  u  q- z; l4 N8 ~
34.     Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
    
36.     Set Part = swApp.ActiveDoc
    & ^, _7 `5 }! U! x& h
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    - {! K! A/ @5 Z1 l; ~6 L
38. 
    
39. End Sub
    8 X# F( {- P; v  p; f' L3 N, q

复制代码

" M" g: `; I. p# m1 I/ v

zx65606

图号分离？

ryouss

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

非也!如主題名稱.
9 K0 A: n; w! W* \' v: G- X
2 k' b( w* s) |7 |- T' a

远祥

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

ryouss

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

$ w) X3 l$ h7 n" M$ `: w2 p0 sCamtasia Studio 8.0 软件截取的
# r- t, Q1 s% s. ^* g