求图号名称分离宏添加新代码

gdzsh

图号名称分离宏（配置属性内）在用到常驻宏时打开工程图会报错，盼能在以下代码中添加如果是工程图就退出的代码，谢谢。

1. '定义变数名称
   
2. 
   
3. Dim S1                 As Integer
   
4. Dim S2                 As Integer
   
5. Dim Path_Name          As String
   
6. Dim Code_Name_C        As String
   
7. Dim Code_              As String
   
8. Dim Name_              As String
   
9. Dim strmat             As String
   
10. Dim Part               As Object
    
11. Dim swApp              As SldWorks.SldWorks
    
12. Dim swModelDoc         As SldWorks.ModelDoc2
    
13. Dim swConfig           As SldWorks.Configuration
    
14. Dim CustPrOPMgr      As SldWorks.CustomPropertyManager
    
15. Dim swModel            As SldWorks.ModelDoc2
    
16. 
    
17. Sub main()
    
18. Set swApp = Application.SldWorks
    
19. Set swModelDoc = swApp.ActiveDoc
    
20. Set swConfig = swModelDoc.ConfigurationManager.ActiveConfiguration
    
21. Set swModel = swApp.ActiveDoc
    
22. Set CustPropMgr = swModel.Extension.CustomPropertyManager(swModel.ConfigurationManager.ActiveConfiguration.Name) '配置特定的延伸设定
    
23. 
    
24. '设定变量
    
25. Path_Name = swApp.ActiveDoc.GetPathName '取得"路径名称及扩展名",不管扩展名是否隐藏
    
26. S1 = InStrRev(Path_Name, "") '\符号在路径的最后位置数
    
27. Code_Name_C = Right(Path_Name, Len(Path_Name) - S1) '取得"件号 名称.扩展名"
    
28. S2 = InStr(Code_Name_C, " ") '符号在"件号 名称 扩展名"的位置数
    
29. Code_ = Left(Code_Name_C, S2 - 1) '取得"件号"
    
30. Name_ = Mid(Code_Name_C, S2 + 1, Len(Code_Name_C) - S2 - 7) '取得“名称”
    
31. strmat = Chr(34) + Trim("SW-Material" + "@@") + "@" + Code_Name_C + Chr(34) '材料属性
    
32. 
    
33. '删除栏
    
34. CustPropMgr.Delete ("代号")
    
35. CustPropMgr.Delete ("名称")
    
36. CustPropMgr.Delete ("材料")
    
37. 
    
38. '新增
    
39. CustPropMgr.Add2 "代号", swCustomInfoText, Code_
    
40. CustPropMgr.Add2 "名称", swCustomInfoText, Name_
    
41. CustPropMgr.Add2 "数量", swCustomInfoText, " "
    
42. CustPropMgr.Add2 "材料", swCustomInfoText, strmat
    
43. CustPropMgr.Add2 "单重", swCustomInfoText, " "
    
44. CustPropMgr.Add2 "总重", swCustomInfoText, " "
    
45. CustPropMgr.Add2 "备注", swCustomInfoText, " "
    
46. 
    
47. End Sub
    

复制代码

onboy9

DaveChan

qxzch

gdzsh

a8012024

gdzsh

Learning_deng

285240263@qq.co