|
经典图书 參考眾大師的結晶,稍加整理一下,因沒經大批量及大容量的組件測試過,
所以建議僅在小批量及小容量的組件試試看了!
執行效果如附图.
- ' ******************************************************************************
- ' macro recorded on 08/11/17 by lsc
- '
- ' 組合件及零件自訂屬性名稱.
- '
- ' 本例之編號名稱是以 "_" 之符號分隔.
- '
- ' 1. 把組件及零件置放在 "同文件路徑" 下
- '
- ' 2. 開組件,執行 main [url=https://www.swbbsc.com/forum-57-1.html]宏[/url]
- '
- ' ******************************************************************************
- Dim TopDocPathOnly As String
- Dim swModel As SldWorks.ModelDoc2
- Dim swApp As SldWorks.SldWorks
- Dim longstatus As Long, longwarnings As Long
- Sub main()
- Set swApp = Application.SldWorks
- Set TopDoc = swApp.ActiveDoc '總裝對象
- If TopDoc.GetType <> 2 Then
- MsgBox ("Open Assembly")
- Exit Sub '不是裝配=退出
- End If
- TopDocPathSplit = Split(TopDoc.GetPathName, "") '分割
- TopDocName = TopDocPathSplit(UBound(TopDocPathSplit)) '總裝文件名稱
- Path_ = TopDoc.GetPathName
- TopDocName = Left(TopDocName, Len(TopDocName) - 7) '總裝文件名稱(排除.SLDASM)
- TopDocPathOnly = TopDocPathSplit(UBound(TopDocPathSplit) - 1) '總裝目錄名稱
- TopConfString = TopDoc.GetActiveConfiguration.Name '總裝[url=https://www.swbbsc.com/forum-53-1.html]配置[/url]名稱
- SubAsm TopDoc, TopConfString '遍歷
- End Sub
- Function SubAsm(AsmDoc, ConfString)
- Dim name_ay() As String
- Set swModel = swApp.ActiveDoc
- Set Configuration = AsmDoc.GetConfigurationByName(ConfString)
- Set RootComponent = Configuration.GetRootComponent
- Components = RootComponent.GetChildren
- For Each Child In Components '總裝抓全部零件名稱
- i = i + 1
- ReDim Preserve name_ay(i)
- Set ChildModel = Child.GetModelDoc
- ChildPathSplit = Split(Child.GetPathName, "") '分割
- ChildName = ChildPathSplit(UBound(ChildPathSplit)) '零件文件名稱
- name_ay(i) = Left(ChildName, Len(ChildName) - 7) '編號_名稱
- swModel.DeleteCustomInfo2 "", name_ay(i)
- swModel.AddCustomInfo2 name_ay(i), swCustomInfoText, """SW-Material@" & name_ay(i) & ".SLDPRT"""
- Next
- '~~~~~~~ parts_property ~~~~~~~
- Dim longstatus As Long, longwarnings As Long
- Dim retval As String
- Set Part = swApp.ActiveDoc
- path_name = Part.GetPathName
- TopDocPathSplit = Split(path_name, "") '分割
- TopDocName = TopDocPathSplit(UBound(TopDocPathSplit))
- Path_ = Left(path_name, Len(path_name) - Len(TopDocName))
- For n = 1 To i
- Set Part = swApp.OpenDoc6(Path_ & name_ay(n) & ".SLDPRT", 1, 0, "", longstatus, longwarnings)
- swApp.ActivateDoc2 name_ay(n) & ".SLDPRT", False, longstatus
- Set swModel = swApp.ActiveDoc
- '~~~ 注意 L1 設定 ~~~
- L1 = InStrRev(name_ay(n), "_", , 0) '編號_名稱是以 "_" 之符號分隔,可依需要更改所需之符號
- '~~~
- code_part = Left(name_ay(n), L1 - 1) ' 編號
- name_part = Right(name_ay(n), Len(name_ay(n)) - L1) '名稱
- retval = swModel.DeleteCustomInfo("材質")
- retval = swModel.AddCustomInfo3("", "材質", swCustomInfoText, """SW-Material@" & name_ay(n) & ".SLDPRT""")
- retval = swModel.DeleteCustomInfo("名稱")
- retval = swModel.AddCustomInfo3("", "名稱", swCustomInfoText, name_part)
- retval = swModel.DeleteCustomInfo("編號")
- retval = swModel.AddCustomInfo3("", "編號", swCustomInfoText, code_part)
- swModel.Save
- swApp.CloseDoc name_ay(n) & ".SLDPRT"
- Next
- End Function
复制代码
Macro1.rar
(7.28 KB, 下载次数: 154, 售价: 10 金币)
swp文件 (繁版)
|
|