奇葩的帖子（7樓：配置名稱分離宏）

傻呼呼分不清是求助还是原创，不能进入学习。

果然与众不同

今天早上看还能看，本来权限是20。问题解决了，没想到现在竟然被那位奇葩楼主把权限弄那么高。

可能发帖人觉得等级低的人看了没有用，防止灌水，所以权限设置的比较高

xiabulai 发表于 2017-3-21 17:28
今天早上看还能看，本来权限是20。问题解决了，没想到现在竟然被那位奇葩楼主把权限弄那么高。

谢谢回复，俺看到的情况一样，本来权限是20，后来有人建议撤销，该楼主也同意的，岂料转眼间权限变成了250，俺还来不及复制代码就看不到了。

会不会不关该楼主的事，是某位版主在作怪呢？？

莱虫 发表于 2017-3-22 14:19
谢谢回复，俺看到的情况一样，本来权限是20，后来有人建议撤销，该楼主也同意的，岂料转眼间权限变成了25 ...

不管是谁作的怪，巧了，我复制下来了。希望“有心人”看到不要见怪。论坛回复的添加代码提交不上，只好直接粘贴了。


Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim ConfigNames As Variant
Dim ConfigName As Variant
Dim ConfigNameSplit As Variant
Dim PartCode As String
Dim PartName As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
ConfigNames = Part.GetConfigurationNames
For Each ConfigName In ConfigNames
    ConfigNameSplit = Split(ConfigName, " ")
    PartCode = ConfigNameSplit(0)
    PartName = ConfigNameSplit(UBound(ConfigNameSplit))
    Part.DeleteCustomInfo2 ConfigName, "名称"
    Part.DeleteCustomInfo2 ConfigName, "图号"
    Part.AddCustomInfo3 ConfigName, "名称", 30, PartName
    Part.AddCustomInfo3 ConfigName, "图号", 30, PartCode
Next
End Sub

管理员检查吧

可能該主題的發帖者不想讓太多人看到內容，因而設定到最高限制。
無論如何，各位都應該尊重發帖者的決定，沒必要深究了。

增加一个，分离当前配置名

1. Option Explicit
   
2. Dim swApp As SldWorks.SldWorks
   
3. Dim Part As SldWorks.ModelDoc2
   
4. Dim ConfigName As String
   
5. Dim ConfigNameSplit As Variant
   
6. Dim PartCode As String
   
7. Dim PartName As String
   
8. Sub main()
   
9. Set swApp = Application.SldWorks
   
10. Set Part = swApp.ActiveDoc
    
11. ConfigName = Part.GetActiveConfiguration.Name
    
12. ConfigNameSplit = Split(ConfigName, " ")
    
13. PartCode = ConfigNameSplit(0)
    
14. PartName = ConfigNameSplit(UBound(ConfigNameSplit))
    
15. Part.DeleteCustomInfo2 ConfigName, "名称"
    
16. Part.DeleteCustomInfo2 ConfigName, "图号"
    
17. Part.AddCustomInfo3 ConfigName, "名称", 30, PartName
    
18. Part.AddCustomInfo3 ConfigName, "图号", 30, PartCode
    
19. End Sub
    

复制代码