solidworks 宏 另存及提取属性命令

蓝血刺猬

一直在用宏，把文件 另存为IGS文件 ，但外发的IGS文件来加上材质，每次都是另存后再改名，太麻烦了，试了几次改宏，都提取不出来材质，哪位大神能帮帮忙啊

3 a, }; e# K5 [) DDim swApp As Object
. ~2 v! w1 F; \' kDim Part As Object
6 T1 o5 r, \% S! U0 XDim Filename As String
2 j5 C4 M' W; @Dim Material As String
Dim No As Integer
' v4 `) f1 K8 ?0 P! u5 R$ {Dim Nom As Integer
2 m2 I& K  L& c+ @! S* yDim Title As String
Sub main()
- C8 a( K4 g/ T# }8 H  T8 a3 GSet swApp = Application.SldWorks
. r. P8 v+ q0 s  LSet Part = swApp.ActiveDoc
Filename = Part.GetPathName()
0 j! E/ t! P' c' L2 ~Materiala = swModel2.GetCustomInfoNames()
  w: d/ x* }& D- KNo = Len(Filename)
Nom = Len(Material)
Filename = Left(Filename, No - 7)
! ?' O& M2 L2 V  a. EMaterial = Left(Material, Nom)
% h' z; n0 h+ E+ q  k  Y* wPart.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
! j: N; B; O  W: w- [% E  I4 F. ~Title = Part.GetTitle
Set Part = Nothing
5 k$ U$ Z' m( c$ ~. l) P& H- ~, Dswmodel.Save '保存文件
swApp.CloseDoc Title
- _& r. i' O$ R0 }/ {; h'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
End Sub
' L; q3 v1 l( q  }. g6 F

这个materiala，试了几次都提取不出来

qiminger

materiala = swModel.GetCustomInfoNames()
- X" u% v! E: i3 D8 x2 m这一句好象是取属性名称数组

先写一个材料的自定义属性名与值
" n' Z/ P" S; n$ L- _- O再取出来运用。
如下本人方法：
$ i$ Y; ]: B! a' N! W4 j

1. Dim swApp As Object
   4 y8 U# z! ~* Y/ `$ `" ~
2. Dim Part As Object
   1 a1 T& _" H$ [$ u( S
3. Dim swModel As Object
   
4. 
   
5. Dim Filename As String
   
6. 'Dim Material As String
   4 U3 J/ f( E- t. |. [6 B: V) H
7. 'Dim No As Integer
   
8. 'Dim Nom As Integer
   3 a" O: O' s/ \$ c
9. Dim Title As String
   
10. Sub main()
    
11. Set swApp = Application.SldWorks
    
12. Set swModel = swApp.ActiveDoc
    * i. \: T3 [# A* p9 G
13. 
    
14. 'Set swApp = Application.SldWorks
    
15. Set Part = swApp.ActiveDoc
    
16. Filename = Part.GetPathName()
    % ?- q7 _8 M! Z% _
17. 'materiala = swModel.GetCustomInfoNames()
    
18. No = Len(Filename)
    
19. 'Nom = Len(Material)
    , B! v- ]5 z2 [/ e
20. 
    
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
    ! Y6 d# N1 v* H' Q9 Q" D. V  w. n
25. Title = Part.GetTitle
    
26. Set Part = Nothing
    ) f# f; @9 v5 U  }7 @1 }
27. swModel.Save '保存文件
    
28. swApp.CloseDoc Title
    
29. 'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
    , ~% ~* \+ z: x  |* ?6 A
30. End Sub
    
31. 
    
32. Private Function QsxZh() As String    '取属性值
    
33. 
    0 r' P" f9 X2 X/ X0 `; A  s+ k7 l
34. Dim retval() As String '自定义属性集合
    
35. Dim i As Integer
    
36. Dim Ming As String '属性名
    
37. Dim Zdysxz As String '自定义值
    
38. Dim blnretval As String
    
39. Dim XrZh As String '写入值
    
40. 
    
41. XrZh = Chr(34) & "SW-Material@" & "part" & ".sldprt" & Chr(34)
    + F3 ?* t* `4 n, _" J5 ?
42. blnretval = Part.AddCustomInfo3("", "temp", swCustomInfoText, XrZh) '写入自定义属性临时名称与值
    + t5 I4 N, l! m
43. retval = Part.GetCustomInfoNames2("") '读出自定义属性名称集合
    
44. For i = 0 To UBound(retval)
    " @; s& \2 K% ~
45.     Zdysxz = Part.GetCustomInfoValue("", retval(i)) '读出自定义值
    8 m+ A/ I! D% W- Z& ~* I" C3 B3 Q
46.     QsxZh = Zdysxz
    2 B0 o6 ~- O! |" L6 D! i
47. Next
    
48. 
    ; X+ e) ]: z; b% Q, `
49. blnretval = Part.DeleteCustomInfo2("", "temp") '删除自定义属性临时名称
    % A% J7 S7 n/ n9 d% ^; a
50. 
      Q: Z: v" X! V9 |9 o# J7 f
51. End Function
      ^4 g- b. E$ U' f

复制代码

) e: Q0 t9 w) P 另存IGS.rar (11.82 KB, 下载次数: 22)

2016-12-13 13:54 上传

点击文件名下载附件
5 A* M; I+ H  o% N" b$ X( c$ }6 H
# ]" ?" q) s: }1 J" |% g

xiatian11

谢谢分享