图号、名称共用文档，宏拆分导入属性；图号名称分离宏

正树

1. Dim swApp As Object
   
2. Dim Part As Object
   
3. Dim SelMgr As Object
   
4. Dim boolstatus As Boolean
   
5. Dim longstatus As Long, longwarnings As Long
   
6. Dim Feature As Object
   
7. Dim a As Integer
   
8. Dim b As String
   
9. Dim m As String
   
10. Dim e As String
    
11. Dim k As String
    
12. Dim t As String
    
13. Dim c As String
    
14. Dim j As Integer
    
15. Dim strmat As String
    
16. Dim tempvalue As String
    
17. Sub main()
    
18. 'link solidworks
    
19. Set swApp = Application.SldWorks
    
20. Set Part = swApp.ActiveDoc
    
21. Set SelMgr = Part.SelectionManager
    
22. swApp.ActiveDoc.ActiveView.FrameState = 1
    
23. '设定变量
    
24. c = swApp.ActiveDoc.GetTitle() '零件名
    
25. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
26. blnretval = Part.DeleteCustomInfo2("", "代号")
    
27. blnretval = Part.DeleteCustomInfo2("", "名称")
    
28. blnretval = Part.DeleteCustomInfo2("", "材料")
    
29. a = InStr(c, " ") - 1      '重点：分隔标识符，这里是一个空格
    
30. If a > 0 Then
    
31.     k = Left(c, a)
    
32.     t = Left(LTrim(e), 3)
    
33.     If t = "GBT" Then
    
34.         e = "GB/T" + Mid(k, 4)
    
35.     Else
    
36.         e = k
    
37.     End If
    
38.     b = Mid(c, a + 2)
    
39.     t = Right(c, 7)
    
40.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    
41.         j = Len(b) - 7
    
42.     Else
    
43.         j = Len(b)
    
44.     End If
    
45.     m = Left(b, j)
    
46. End If
    
47. blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)  '代号
    
48. blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)  '名称
    
49. blnretval = Part.AddCustomInfo3("", "表面处理", swCustomInfoText, " ")
    
50. End Sub

复制代码

cx0527

谢分享，这个要怎么用

正树

32762625 发表于 2017-5-3 07:15
谢谢分享，这个要怎么用

我们V3版，会把这个给大家免费分享出来，暂时卖关子哈

daeren355

这个不错老大威武！

32762625

谢谢分享，这个要怎么用