solidworks 宏 另存及提取属性命令

蓝血刺猬

一直在用宏，把文件 另存为IGS文件 ，但外发的IGS文件来加上材质，每次都是另存后再改名，太麻烦了，试了几次改宏，都提取不出来材质，哪位大神能帮帮忙啊
7 c: o: x; V; F9 Q( _/ N. a
Dim swApp As Object
Dim Part As Object
Dim Filename As String
Dim Material As String
. }9 T4 b+ k* H( n7 b, q' k( aDim No As Integer
Dim Nom As Integer
7 }5 L7 r/ T+ PDim Title As String
* N. J9 k& `- Q1 [* M. G. z5 p/ Z/ WSub main()
; O0 L, |1 l) o8 c3 u3 n2 E/ S) K$ @Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Filename = Part.GetPathName()
* A% K) h- ~! a! K- t$ lMateriala = swModel2.GetCustomInfoNames()
1 c, k5 \8 g# t; H( d% zNo = Len(Filename)
" {9 x6 b( X7 tNom = Len(Material)
* q, ~; {( k' H2 B: oFilename = Left(Filename, No - 7)
: A" a6 `! ?1 l% g+ t( CMaterial = Left(Material, Nom)
Part.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
3 I( ]( j7 W+ U5 q. oTitle = Part.GetTitle
8 A9 H/ U9 F6 g( }0 ^Set Part = Nothing
: y* r/ D4 t! `% `, I0 gswmodel.Save '保存文件
swApp.CloseDoc Title
9 Y/ ^) `, V( J0 e8 Z5 \'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
End Sub
3 @$ t# j2 M% T; X, s4 `1 ~6 u

/ I2 T+ R* M2 d) [( I这个materiala，试了几次都提取不出来
/ x# R/ Z) A' y/ ?/ K

qiminger

materiala = swModel.GetCustomInfoNames()
$ C  q/ k- K+ E/ s2 B- e这一句好象是取属性名称数组

0 U9 }; y+ {  o5 n先写一个材料的自定义属性名与值
再取出来运用。
如下本人方法：

1. Dim swApp As Object
   
2. Dim Part As Object
   
3. Dim swModel As Object
   7 c- E" P5 S0 Q3 {; d" Z
4. 
   9 q: t5 }, Q$ F+ a0 ?  G# Z& x
5. Dim Filename As String
   
6. 'Dim Material As String
   ' d8 ]% @! h% H) i
7. 'Dim No As Integer
   
8. 'Dim Nom As Integer
   
9. Dim Title As String
   # ~) n' d/ o/ K7 {
10. Sub main()
    
11. Set swApp = Application.SldWorks
    
12. Set swModel = swApp.ActiveDoc
    + V' P" K' I! E! o! @
13. 
    ( t0 x' M# `/ s4 n" }8 e
14. 'Set swApp = Application.SldWorks
    2 c5 Y6 W1 R8 W+ d+ D
15. Set Part = swApp.ActiveDoc
    
16. Filename = Part.GetPathName()
    / R3 K7 _' Q) j
17. 'materiala = swModel.GetCustomInfoNames()
    $ ^* h* ^) V; V3 C. u& t
18. No = Len(Filename)
    
19. 'Nom = Len(Material)
    
20. 
    0 b# |1 d: N6 M4 y3 w. G( ]- f" l- `
21. Filename = Left(Filename, No - 7)
    6 b3 E7 H5 {5 B$ y
22. 'Material = Left(Material, Nom)
    
23. 'Part.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
    
24. Part.SaveAs2 Filename & "-" & QsxZh & ".IGS", 0, True, False
    8 ^1 Y& x& Z6 ]# K
25. Title = Part.GetTitle
    ) @9 k4 H9 A% L' s# j8 T' k
26. Set Part = Nothing
    , P) X5 Q0 @" J, ]) U
27. swModel.Save '保存文件
    4 o0 d( X1 [7 \$ u" @$ C; b: _1 l4 T  c
28. swApp.CloseDoc Title
    
29. 'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
    
30. End Sub
    
31. 
    
32. Private Function QsxZh() As String    '取属性值
    
33. 
    " r/ w$ J# G& Q; Q1 W2 a
34. Dim retval() As String '自定义属性集合
    ! F1 h, b0 b# q$ {
35. Dim i As Integer
    
36. Dim Ming As String '属性名
    ; s  d$ }& i. q5 g& p  A' u
37. Dim Zdysxz As String '自定义值
    
38. Dim blnretval As String
    # A* h/ T4 R; P- D0 q- U
39. Dim XrZh As String '写入值
    ) m$ k' m, p) w8 z" y) R
40. 
    
41. XrZh = Chr(34) & "SW-Material@" & "part" & ".sldprt" & Chr(34)
    
42. blnretval = Part.AddCustomInfo3("", "temp", swCustomInfoText, XrZh) '写入自定义属性临时名称与值
    5 _" V7 R; [& q" \  N
43. retval = Part.GetCustomInfoNames2("") '读出自定义属性名称集合
    6 N  e# N- K0 j3 h6 i
44. For i = 0 To UBound(retval)
    & q4 \0 @" S' x# g( p6 B
45.     Zdysxz = Part.GetCustomInfoValue("", retval(i)) '读出自定义值
    / b, \! W6 R  y2 C+ p1 n
46.     QsxZh = Zdysxz
    
47. Next
    
48. 
    
49. blnretval = Part.DeleteCustomInfo2("", "temp") '删除自定义属性临时名称
    
50. 
    
51. End Function
    + @) B1 B$ X& b7 O. T* a

复制代码

% v% A% @4 X, ?. r. V6 r 另存IGS.rar (11.82 KB, 下载次数: 22)

2016-12-13 13:54 上传

点击文件名下载附件

8 \1 C8 d. L! }) l7 q  Q

xiatian11

谢谢分享