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

ryouss

, g, {. c6 p2 \+ n8 A, u參考

- ^. o$ l' N) O  O# J4 b
9 H- |" H6 j$ L/ D1 L4 `2 e
* _. P* D8 Q' B. U7 J/ R- V
) x, V" K& ^$ @
  x, w- t& @* m: x/ R

1. ' ************************************************************************************
   0 O. G8 n9 F* O
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   ) n2 l4 q3 N5 v. M
3. ' ************************************************************************************
   " E* n& S# x3 _$ U& z
4. 
   2 ]4 s$ [2 o: r  |3 z
5.     Dim swApp               As SldWorks.SldWorks
   
6.     Dim swModel             As SldWorks.ModelDoc2
   
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   
8.     Dim swConfig            As SldWorks.Configuration
   
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   
10.     Dim nNbrProps           As Long
    
11.     Dim Part                As Object
    3 I& f: G* ~3 B) v
12.     Dim Code_Name(2)        As String
      A$ K% o2 w( C6 m0 b% h
13.     Dim valOut              As String
    
14.     Dim resolvedValOut      As String
    6 V$ u  P7 d- e
15.     Dim longstatus          As Long
    
16. 
    + E! {4 q) j2 \  l* b2 f6 E% s; D
17. 
    
18. Sub main()
    . f4 |6 w* R+ c& C4 \+ i7 U
19. 
    6 a6 |; E1 C& u- O. H
20.     Set swApp = Application.SldWorks
    ) z7 z4 k  d+ w. e, [- N
21.     Set swModel = swApp.ActiveDoc
    
22.     Set swConfigMgr = swModel.ConfigurationManager
    
23.     Set swConfig = swConfigMgr.ActiveConfiguration
      u- Y1 P$ d2 L! n) @
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    ; L0 y( B8 h- R" G8 M! m: m$ j& f1 o
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
    ; c/ p. k9 Z1 y6 P
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    ' h: y4 a8 M' s7 c! `
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)
    
34.     Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    1 b0 B/ c* T* b0 d' L8 a
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
      _' _8 T# e$ c' i& g3 u
36.     Set Part = swApp.ActiveDoc
    , {) [9 c- {. U
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    
38. 
    ( X6 t7 r6 f( t0 Y' \! |% @6 X% _
39. End Sub
    5 ]2 G% S7 t( ~6 [$ F! }& s/ ~

复制代码

5 Z# c1 \0 {1 L" T" A3 Q
/ A6 B7 T7 P4 f# Q! O+ W8 e  o

xiatian11

7 M9 c" ]2 j) m* D
3 h9 g- v) V, Z; }3 @& X感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

阿帕奇

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

: n3 ^+ W& S) p) x1 U1 g那是对山寨网防范的办法之一

阿帕奇

一直都视而见

hdgd501

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