lin105725366 发表于 2023-12-7 19:32:39

SolidWorks宏

Dim TopDocPathOnly As StringDim swModel As SldWorks.ModelDoc2Dim swApp As SldWorks.SldWorksDim longstatus As Long, longwarnings As Long
Sub main()Set swApp = Application.SldWorksSet TopDoc = swApp.ActiveDoc '總裝對象If TopDoc.GetType <> 2 Then    MsgBox ("Open Assembly")    Exit Sub '不是裝配=退出End IfTopDocPathSplit = Split(TopDoc.GetPathName, "") '分割TopDocName = TopDocPathSplit(UBound(TopDocPathSplit)) '總裝文件名稱Path_ = TopDoc.GetPathNameTopDocName = Left(TopDocName, Len(TopDocName) - 7) '總裝文件名稱（排除.SLDASM）TopDocPathOnly = TopDocPathSplit(UBound(TopDocPathSplit) - 1) '總裝目錄名稱TopConfString = TopDoc.GetActiveConfiguration.Name '總裝配置名稱SubAsm TopDoc, TopConfString '遍歷
End Sub
Function SubAsm(AsmDoc, ConfString)Dim name_ay() As StringSet swModel = swApp.ActiveDocSet Configuration = AsmDoc.GetConfigurationByName(ConfString)Set RootComponent = Configuration.GetRootComponentComponents = RootComponent.GetChildrenFor 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 LongDim retval As StringSet Part = swApp.ActiveDocpath_name = Part.GetPathNameTopDocPathSplit = 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"NextEnd Function

样胜 发表于 2023-12-8 08:05:25

66666666666666

qiminger 发表于 2023-12-12 10:55:03

TopDocPathSplit = Split(TopDoc.GetPathName, "\") '分割

吉林晔华 发表于 2023-12-24 19:27:32

没管用，哪里有问题？
页: [1]
查看完整版本: SolidWorks宏