solidworks 宏 另存及提取属性命令

蓝血刺猬

一直在用宏，把文件 另存为IGS文件 ，但外发的IGS文件来加上材质，每次都是另存后再改名，太麻烦了，试了几次改宏，都提取不出来材质，哪位大神能帮帮忙啊
. v# G' X( g. j! H6 c9 a
Dim swApp As Object
Dim Part As Object
4 Z7 ?% e9 P: u/ Q- DDim Filename As String
% L2 N: _( E* T/ ^Dim Material As String
Dim No As Integer
Dim Nom As Integer
Dim Title As String
8 `# ?3 v" `$ }9 BSub main()
Set swApp = Application.SldWorks
5 B# ^! U5 _% fSet Part = swApp.ActiveDoc
  U5 z. D3 Y: ~9 A' vFilename = Part.GetPathName()
Materiala = swModel2.GetCustomInfoNames()
No = Len(Filename)
% D. }/ E# I1 V7 [2 g5 jNom = Len(Material)
5 T3 }0 o# L( ^/ V+ `' g* A3 PFilename = Left(Filename, No - 7)
% Y; c8 r' Q5 G- L$ A, D! O4 o1 X7 uMaterial = Left(Material, Nom)
9 @0 A- d; N/ r3 @% T+ [2 h' G7 b) ?Part.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
Title = Part.GetTitle
Set Part = Nothing
; n4 s' n. h9 ~' E" G2 V# y& yswmodel.Save '保存文件
swApp.CloseDoc Title
'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
End Sub

6 a" e9 X+ H4 X- [/ v
这个materiala，试了几次都提取不出来

qiminger

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

' m8 C+ ~. h! m2 I  }: b  N  _先写一个材料的自定义属性名与值
" X  I+ X. J+ e9 G再取出来运用。
如下本人方法：
  q) s; Q& t: N/ n

1. Dim swApp As Object
   $ T/ ?% ^, s+ W7 }1 N1 t3 }
2. Dim Part As Object
   
3. Dim swModel As Object
   
4. 
   
5. Dim Filename As String
   4 n8 j) s- }/ g
6. 'Dim Material As String
   
7. 'Dim No As Integer
   
8. 'Dim Nom As Integer
   
9. Dim Title As String
   0 f5 I! F, h8 R/ e
10. Sub main()
    
11. Set swApp = Application.SldWorks
    
12. Set swModel = swApp.ActiveDoc
    
13. 
    9 H! U' ]9 T+ x6 p
14. 'Set swApp = Application.SldWorks
    ( T/ F: A. U: u
15. Set Part = swApp.ActiveDoc
    
16. Filename = Part.GetPathName()
    $ e, q$ E# E7 Q. K9 _5 _8 J& P; V7 g
17. 'materiala = swModel.GetCustomInfoNames()
    
18. No = Len(Filename)
    ; K$ D. Q4 C& b$ V! z
19. 'Nom = Len(Material)
    ( f* F/ [* i/ x7 _' y. C
20. 
    ( @4 R" t1 h- F- ]( E
21. Filename = Left(Filename, No - 7)
    
22. 'Material = Left(Material, Nom)
    ' T  ?' I5 H. D* U! x6 Z' r( k: t
23. 'Part.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
    8 x% h6 M* [, N
24. Part.SaveAs2 Filename & "-" & QsxZh & ".IGS", 0, True, False
    * b7 o, t/ }, j1 u
25. Title = Part.GetTitle
    
26. Set Part = Nothing
    
27. swModel.Save '保存文件
    
28. swApp.CloseDoc Title
    . u  e" t- f- F  J7 {+ j
29. 'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
    
30. End Sub
    
31. 
    . z  Q7 J( }! L$ ?- h: J* D1 R; \
32. Private Function QsxZh() As String    '取属性值
    - u. I# z  v4 K: }. r) P
33. 
    6 b, l- c1 S1 ]3 \4 |
34. Dim retval() As String '自定义属性集合
    + ^4 ~3 l, ?) K1 E1 o8 B- C
35. Dim i As Integer
    
36. Dim Ming As String '属性名
      t9 j8 Z/ N( X# A
37. Dim Zdysxz As String '自定义值
    
38. Dim blnretval As String
    + ~/ I( v2 L1 X1 z$ M0 H* _
39. Dim XrZh As String '写入值
    ) a, c+ k! `( ^: n% ^- Y' f
40. 
    * B6 f* }0 ]1 j7 n+ F/ P
41. XrZh = Chr(34) & "SW-Material@" & "part" & ".sldprt" & Chr(34)
    
42. blnretval = Part.AddCustomInfo3("", "temp", swCustomInfoText, XrZh) '写入自定义属性临时名称与值
    
43. retval = Part.GetCustomInfoNames2("") '读出自定义属性名称集合
    & r9 R# [  O) a3 x
44. For i = 0 To UBound(retval)
    
45.     Zdysxz = Part.GetCustomInfoValue("", retval(i)) '读出自定义值
    
46.     QsxZh = Zdysxz
    
47. Next
    . Q4 |; I) |0 A* g3 h, I
48. 
    
49. blnretval = Part.DeleteCustomInfo2("", "temp") '删除自定义属性临时名称
    
50. 
    
51. End Function
    

复制代码

另存IGS.rar (11.82 KB, 下载次数: 22)

2016-12-13 13:54 上传

点击文件名下载附件
! K1 Z" D  E) i/ m

xiatian11

谢谢分享