solidworks 宏 另存及提取属性命令

蓝血刺猬

一直在用宏，把文件 另存为IGS文件 ，但外发的IGS文件来加上材质，每次都是另存后再改名，太麻烦了，试了几次改宏，都提取不出来材质，哪位大神能帮帮忙啊
$ e1 P, M0 n7 p* o, o/ X
Dim swApp As Object
Dim Part As Object
Dim Filename As String
Dim Material As String
- z! h' t: S' T$ E; B; yDim No As Integer
7 j7 T9 f1 r" A5 e. S6 lDim Nom As Integer
Dim Title As String
Sub main()
' F" J0 b3 {$ y+ y3 Z2 x! {5 E0 eSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Filename = Part.GetPathName()
4 t0 w! o+ `1 \) SMateriala = swModel2.GetCustomInfoNames()
No = Len(Filename)
Nom = Len(Material)
/ v+ i5 b7 u6 B+ c. `2 C! [Filename = Left(Filename, No - 7)
Material = Left(Material, Nom)
5 w8 m. q0 b8 mPart.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
Title = Part.GetTitle
! {2 V  |) q" }6 gSet Part = Nothing
swmodel.Save '保存文件
swApp.CloseDoc Title
- Y" S# M( L' k& h'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
5 S( K* w% b6 J4 zEnd Sub

, q$ n- ]/ F( v
这个materiala，试了几次都提取不出来

qiminger

materiala = swModel.GetCustomInfoNames()
这一句好象是取属性名称数组
/ n( ]7 H1 C- Q9 Y* A7 S( ~+ J: Q
先写一个材料的自定义属性名与值
7 j& `. y5 t& @9 f3 ^, I再取出来运用。
- N# w6 L" m, k( W" N9 C如下本人方法：

1. Dim swApp As Object
   
2. Dim Part As Object
   2 ~+ t) T6 N# i% G
3. Dim swModel As Object
   
4. 
   
5. Dim Filename As String
   
6. 'Dim Material As String
   
7. 'Dim No As Integer
   # F( U# ~1 z- @, u. Z# i. f
8. 'Dim Nom As Integer
   3 \! n  J6 H. A
9. Dim Title As String
   ! x& `: D7 K, E: K7 N/ b' V
10. Sub main()
    
11. Set swApp = Application.SldWorks
    : _$ J% ]. t5 a7 k7 I3 U
12. Set swModel = swApp.ActiveDoc
    
13. 
    ; w. j6 |/ r6 v0 N0 E2 T2 u, v; a
14. 'Set swApp = Application.SldWorks
    , b- L) X( O* U" F. G3 q5 `
15. Set Part = swApp.ActiveDoc
    7 F! J9 L6 p7 \1 L
16. Filename = Part.GetPathName()
    & {" s' k% t: E& L. v
17. 'materiala = swModel.GetCustomInfoNames()
    
18. No = Len(Filename)
    
19. 'Nom = Len(Material)
    
20. 
    
21. Filename = Left(Filename, No - 7)
    1 i  I, O2 E& B
22. 'Material = Left(Material, Nom)
    2 l5 \8 S# w, |* z# k
23. 'Part.SaveAs2 Filename & "-" & Material & ".IGS", 0, True, False
    ( |! \: v  A  z8 m" ^: |+ q9 \
24. Part.SaveAs2 Filename & "-" & QsxZh & ".IGS", 0, True, False
    
25. Title = Part.GetTitle
    
26. Set Part = Nothing
    
27. swModel.Save '保存文件
    $ J+ L8 H6 f" p/ k6 U2 E
28. swApp.CloseDoc Title
    / Y/ k( Q5 s& E7 H
29. 'X = MsgBox("输出IGS文件在SW工程图同一文件夹", 0)
    
30. End Sub
    % I" A5 H: z9 d, e# G" f: h: y' U
31. 
    
32. Private Function QsxZh() As String    '取属性值
    ; k1 I$ Z5 o" i! z% m& w6 U
33. 
    
34. Dim retval() As String '自定义属性集合
    2 N$ c. X4 M$ }/ j0 ]
35. Dim i As Integer
    
36. Dim Ming As String '属性名
    + M! x) M. L2 V; U3 a
37. Dim Zdysxz As String '自定义值
    5 q  \7 m, [) X) i% a
38. Dim blnretval As String
    
39. Dim XrZh As String '写入值
    - Z( J# D+ Z2 h: {7 ?
40. 
    
41. XrZh = Chr(34) & "SW-Material@" & "part" & ".sldprt" & Chr(34)
    * u  g7 Y# S/ B; B; E5 B
42. blnretval = Part.AddCustomInfo3("", "temp", swCustomInfoText, XrZh) '写入自定义属性临时名称与值
    * q/ T- [  ]" e# k* e/ N: E6 J1 D2 q
43. retval = Part.GetCustomInfoNames2("") '读出自定义属性名称集合
    8 Z, D6 w* f/ e0 S; L6 ~; o
44. For i = 0 To UBound(retval)
    
45.     Zdysxz = Part.GetCustomInfoValue("", retval(i)) '读出自定义值
    * H* H3 ?: ~4 }" n* G/ F+ ^
46.     QsxZh = Zdysxz
    
47. Next
    
48. 
    ! a) i. g, v* a- @
49. blnretval = Part.DeleteCustomInfo2("", "temp") '删除自定义属性临时名称
    ; f. j# @8 m+ M3 s: Z
50. 
    
51. End Function
    8 \8 `: J$ j( a: M

复制代码

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

2016-12-13 13:54 上传

点击文件名下载附件

$ F4 L+ B& }6 u0 o8 G/ _& ~

xiatian11

谢谢分享