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

ryouss

參考



$ T7 G+ r% p1 A& w2 l1 q
' r- B# k- p, ?. S
( E$ x2 e/ d: L4 k( Y3 F+ R7 ~

1. ' ************************************************************************************
   ; h: q4 F" n" V3 [8 @
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   , C1 Y0 _2 g" t8 |5 e8 }7 X) p7 P1 X
3. ' ************************************************************************************
   ( r/ A" \: K- b+ ~
4. 
   
5.     Dim swApp               As SldWorks.SldWorks
   7 t/ Y; S4 q; v/ r0 I' F
6.     Dim swModel             As SldWorks.ModelDoc2
   8 q& L7 X2 f  U6 z
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   
8.     Dim swConfig            As SldWorks.Configuration
   
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   
10.     Dim nNbrProps           As Long
    + c: E" x0 _# m! E. ]7 C( N  l
11.     Dim Part                As Object
    
12.     Dim Code_Name(2)        As String
    
13.     Dim valOut              As String
    ! {3 L! C& m9 a1 f7 P1 J
14.     Dim resolvedValOut      As String
    
15.     Dim longstatus          As Long
    . p& F9 k1 A+ _4 m" m
16. 
    " c0 d6 l7 f0 K3 X, b
17. 
    9 K. _' Q& D+ v; X5 k" R" J- y1 G
18. Sub main()
    
19. 
    5 u9 W9 }( v* N6 @& `! h
20.     Set swApp = Application.SldWorks
    % O+ F. ^3 p, s$ p5 n, H4 w
21.     Set swModel = swApp.ActiveDoc
    $ R+ z8 U& K( s4 }9 Q
22.     Set swConfigMgr = swModel.ConfigurationManager
    3 }$ M% o; C  Q! Q3 T8 @
23.     Set swConfig = swConfigMgr.ActiveConfiguration
    
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    
25.     ' Get the number of custom properties for this configuration
    
26.     nNbrProps = swCustPropMgr.Count
    ; r0 O! k- `. L. b, Z: K& X
27.     vPropNames = swCustPropMgr.GetNames
    & }% |+ A4 Z+ T$ W2 K! K( M
28.     For j = 0 To nNbrProps - 1
    
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    ' a- w, r$ x, d' ~$ f) W8 U' V
30.         If vPropNames(j) = "代號" Then Code_Name(0) = valOut
    
31.         If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
    $ T0 e' i, M) F$ t& |5 ]2 E
32.     Next j
    ( Z/ a# d4 P3 u. V" S4 q+ V
33.     'Debug.Print "    Name, type, and resolved value of custom property:  " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)
    ( K1 \- y. V" c4 M
34.     Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
    * h' E6 f$ w  |7 V  {( n
36.     Set Part = swApp.ActiveDoc
    ) {" |, ?9 x- E  s/ l1 [" w7 z" T
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    
38. 
    
39. End Sub
    " l0 C, L/ ?9 t6 S$ X# O5 C& F8 \) T

复制代码

xiatian11

感谢分享。     三维网粘贴的代码里面老是多出一些乱码，几年了论坛的坛主就一直视而不见

阿帕奇

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

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

阿帕奇

一直都视而见

hdgd501

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