solidworks 宏 另存及提取属性命令

蓝血刺猬

一直在用宏，把文件 另存为IGS文件 ，但外发的IGS文件来加上材质，每次都是另存后再改名，太麻烦了，试了几次改宏，都提取不出来材质，哪位大神能帮帮忙啊
1 i" F8 a4 |8 `2 L0 N4 f1 a$ Y8 Z# s
Dim swApp As Object
) q: u) _% w1 T9 |: ^Dim Part As Object
  t* C( Y9 N( s6 EDim Filename As String
7 k' ~' `9 j  `7 M: V; Q7 B, X& eDim Material As String
  k/ K2 y$ T9 }5 U9 f. H  \2 bDim No As Integer
Dim Nom As Integer
Dim Title As String
, M$ T7 H/ X9 C- z8 ESub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Filename = Part.GetPathName()
+ O! l) k7 h# k+ T' {! sMateriala = swModel2.GetCustomInfoNames()
No = Len(Filename)
Nom = Len(Material)
5 V6 `' i4 |4 r, z% E, U+ Y6 `* WFilename = Left(Filename, No - 7)
Material = Left(Material, Nom)
1 t8 Q( E  W5 U, t: KPart.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
Title = Part.GetTitle
Set Part = Nothing
swmodel.Save '保存文件
swApp.CloseDoc Title
% O0 E/ n8 H& F0 J- E'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
* \3 ]0 W5 j5 h+ h; G, CEnd Sub
  k( ?4 m3 J/ T. q" Y) W

这个materiala，试了几次都提取不出来
$ G  y- ]7 o* P6 N# v+ ?) I# G# @

qiminger

materiala = swModel.GetCustomInfoNames()
这一句好象是取属性名称数组

先写一个材料的自定义属性名与值
4 V; g; P# `! ?+ _* E再取出来运用。
& g/ M, X: j6 H! p, t& b如下本人方法：
: X) g/ ?4 x. w0 i$ }

1. Dim swApp As Object
   4 }0 b+ P" Y+ X! A; b* B& d
2. Dim Part As Object
   
3. Dim swModel As Object
   0 p/ J$ V5 a7 Q
4. 
   ) e4 C  b4 o4 Z, @+ Y
5. Dim Filename As String
   
6. 'Dim Material As String
     n+ J3 U( D0 ]; B+ ]
7. 'Dim No As Integer
   9 C. v. e( m5 D% i, {, p
8. 'Dim Nom As Integer
   
9. Dim Title As String
   
10. Sub main()
    
11. Set swApp = Application.SldWorks
    ' ]8 k5 ^- W, I& ~4 Q4 k+ G4 {" W
12. Set swModel = swApp.ActiveDoc
    
13. 
    ( g$ d0 G; W" D( h% n* {$ x
14. 'Set swApp = Application.SldWorks
    
15. Set Part = swApp.ActiveDoc
    
16. Filename = Part.GetPathName()
    8 K- A( }" e" Q. h7 K
17. 'materiala = swModel.GetCustomInfoNames()
    5 D2 j* M' E* B0 W
18. No = Len(Filename)
    0 u7 Z2 y, t& z; m3 M& f
19. 'Nom = Len(Material)
    6 L% F2 \7 Q* g
20. 
    ' ^9 y/ R" R4 m* E/ b7 h6 s+ P
21. Filename = Left(Filename, No - 7)
    
22. 'Material = Left(Material, Nom)
    
23. 'Part.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
    
24. Part.SaveAs2 Filename & "-" & QsxZh & ".IGS", 0, True, False
    9 W. ?6 K* r# T- R) I0 S9 @/ c
25. Title = Part.GetTitle
    
26. Set Part = Nothing
    ) x. s1 H$ L* n* L; Z+ m
27. swModel.Save '保存文件
    
28. swApp.CloseDoc Title
    1 m. ^& y* c9 c- `, @
29. 'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
      t2 g/ ]' r8 A/ p
30. End Sub
    
31. 
    
32. Private Function QsxZh() As String    '取属性值
    
33. 
    
34. Dim retval() As String '自定义属性集合
    
35. Dim i As Integer
    . q7 E6 I3 K1 g9 J- b
36. Dim Ming As String '属性名
    
37. Dim Zdysxz As String '自定义值
    $ s2 Y/ `* U  m/ \
38. Dim blnretval As String
    
39. Dim XrZh As String '写入值
    3 o- [6 G! R4 v3 z
40. 
    
41. XrZh = Chr(34) & "SW-Material@" & "part" & ".sldprt" & Chr(34)
    ) [" R$ n9 I5 y7 Z& Q: |! X/ u1 G1 `; Y9 O
42. blnretval = Part.AddCustomInfo3("", "temp", swCustomInfoText, XrZh) '写入自定义属性临时名称与值
    7 K2 @6 A" T2 i, U. x' P: u
43. retval = Part.GetCustomInfoNames2("") '读出自定义属性名称集合
    
44. For i = 0 To UBound(retval)
    2 f) U  m$ S1 N/ t9 m# M/ R
45.     Zdysxz = Part.GetCustomInfoValue("", retval(i)) '读出自定义值
    
46.     QsxZh = Zdysxz
    
47. Next
    8 x6 a2 g$ K( ?! B5 Y- G
48. 
    * L& a' P/ @+ O* s- J% c
49. blnretval = Part.DeleteCustomInfo2("", "temp") '删除自定义属性临时名称
    ; v' I7 T" F% ~2 Y6 r5 z# n* [
50. 
    
51. End Function
    & @' i" k4 g2 n1 K: I

复制代码

& o" M# C" {4 v! M7 g& R 另存IGS.rar (11.82 KB, 下载次数: 22)

2016-12-13 13:54 上传

点击文件名下载附件

xiatian11

谢谢分享