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

ryouss

- S5 F* ^! ^: q' }分享在他網的回覆

! m; k5 ~0 w* J5 o/ f( R

1. ' ************************************************************************************
   8 W  l& F/ U/ t5 l
2. ' 依據配置特定屬性之"件號"及"名稱"存檔 - macro recorded on 10/30/18 by scliang
   
3. ' ************************************************************************************
   ( _  j1 n/ C" j# O
4. 
   8 Y; \$ _6 Q7 Z' c  I' }
5.     Dim swApp               As SldWorks.SldWorks
   
6.     Dim swModel             As SldWorks.ModelDoc2
   
7.     Dim swConfigMgr         As SldWorks.ConfigurationManager
   
8.     Dim swConfig            As SldWorks.Configuration
   8 e. ?/ @3 v: G4 b' B
9.     Dim swCustPropMgr       As SldWorks.CustomPropertyManager
   
10.     Dim nNbrProps           As Long
    ! `& l# s) P% ^# ]" p. [2 h: n
11.     Dim Part                As Object
    
12.     Dim Code_Name(2)        As String
    
13.     Dim valOut              As String
    
14.     Dim resolvedValOut      As String
    
15.     Dim longstatus          As Long
    3 N. m0 t+ r/ M/ _
16. 
      C5 L* ^1 r; B$ y
17. 
    
18. Sub main()
    * Q# E4 o9 H" O0 r
19. 
    
20.     Set swApp = Application.SldWorks
    
21.     Set swModel = swApp.ActiveDoc
    ! q+ A' F3 r+ j! w
22.     Set swConfigMgr = swModel.ConfigurationManager
    6 t; q! {; G2 C2 J
23.     Set swConfig = swConfigMgr.ActiveConfiguration
    ; ]1 ~0 b5 _3 Y# V! B
24.     Set swCustPropMgr = swConfig.CustomPropertyManager
    
25.     ' Get the number of custom properties for this configuration
    2 u, D5 O- j/ }! Z
26.     nNbrProps = swCustPropMgr.Count
    2 H/ Y- Y8 o& F. s# Y: B( D3 F
27.     vPropNames = swCustPropMgr.GetNames
    
28.     For j = 0 To nNbrProps - 1
    + }# p1 @% u  K
29.         swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
    
30.         If vPropNames(j) = "代號" Then Code_Name(0) = valOut
    4 T4 _$ {) h6 X# `
31.         If vPropNames(j) = "名稱" Then Code_Name(1) = valOut
    : j) D" x& N' B/ V" @
32.     Next j
    + g, L, |4 a9 z$ I8 s, G
33.     'Debug.Print "    Name, type, and resolved value of custom property:  " & "代號: " & Code_Name(0) & " ----- " & "名稱:" & Code_Name(1)
    
34.     Path_Name = swApp.ActiveDoc.GetPathName '取得"路徑名稱及擴展名",不管擴展名是否隱藏
    
35.     Path_ = Left(Path_Name, InStrRev(Path_Name, "")) '提出路徑
    + @6 W( A, t+ U% s
36.     Set Part = swApp.ActiveDoc
    & l# l- X3 g4 C- g! l
37.     longstatus = Part.SaveAs3(Path_ & Code_Name(0) & " " & Code_Name(1) & ".SLDPRT", 0, 2) '依據配置屬性"件號"及"名稱"存檔
    
38. 
    4 Q7 ?4 _4 A5 Q& C4 p
39. End Sub
    

复制代码

zx65606

图号分离？

ryouss

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

( Z# ]. |" D3 ~4 L1 O5 ^, P非也!如主題名稱.

远祥

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

ryouss

远祥 发表于 2018-11-16 22:06
6 B+ [8 r, a( o8 Z- Y这个动态图楼主用什么软件截取的，求教一下！！

* Z8 F+ t& h9 x( iCamtasia Studio 8.0 软件截取的
7 V1 I+ _) n1 O2 `* `" i' h' R