SW VBA填写文件属性.docxVIP

定义SolidworkDim swApp As SldWorks.SldWorksDim swModel As SldWorks.ModelDoc2Dim config As SldWorks.ConfigurationDim cusPropMgr As SldWorks.CustomPropertyManagerDim ResolvedValOut As StringDim ResolvedValOutArray As VariantDim IsAsm As BooleanDim PartName As String 名称→物料名称Dim PartNameArray As Variant 模板名称列表Dim Standard As String 代号→标准号Dim PartNumber As String 图号，料号Dim ProjectName As String 项目名称Dim FileInfoDisplay As Boolean 属性界面信息Dim PartPathName, PartTitle As StringPublic Sub AutoPartNumberAndName()ProjectName = GetProjectName 获取项目名称Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc If swModel Is Nothing Then MsgBox (没有可用的文件！) Exit Sub End If PartPathName = swModel.GetPathName() 零件名 If (PartPathName = ) Then MsgBox (没有保存文件，请保存或另存为！) Exit Sub End If t = Right(PartPathName, 7) If (t = .SLDPRT Or t = .sldprt Or t = .SLDASM Or t = .sldasm) = False Then MsgBox (文件类型必须为装配体或零件！) Exit Sub End If Set config = swModel.GetActiveConfiguration Set cusPropMgr = config.CustomPropertyManager PartTitle = swModel.GetTitle() SpacePos = InStr(PartTitle, ) - 1 分隔标识符位置 If Left(PartTitle, 2) = GB Then Call ModifyMDProperty(cusPropMgr) 迈迪标准件的文件修改 ElseIf SpacePos = 0 Then 如果没有分隔标识符 MsgBox (文件名中没有空格，请重命名！ Chr(10) 料号与物料名称以空格间隔，例：”014.J0.000.S0 定位夹具“) Exit Sub Else t = Right(PartTitle, 7) If (t = .SLDPRT Or t = .sldprt Or t = .SLDASM Or t = .sldasm) = False Then PartTitle = PartTitle Right(PartPathName, 7) End If Call PropertyNameInitial(cusPropMgr, PartTitle) 模板初始化 PartNumber = Left(PartTitle, SpacePos) 图号 b = Mid(PartTitle, SpacePos + 2) t = Right(PartTitle, 7) If t = .SLDPRT Or t = .sldprt Or t = .SLDASM Or t = .sldasm Then j = Len(b) - 7 Else j = Len(b) End If If t = .SLDASM Or t = .sldasm Then IsAsm = True Else IsAsm = False End If PartName = Left(b, j) 零部件名称 PointPos = InStr(PartTitle, .) If PointPos 0 And Mid(PartNumber, PointPos + 3, 1) = . And Mid(PartNumber, PointPos + 7, 1) = . Then lRetVal = cusPropMgr.Set(料号, PartNumber) lRetVal = cusPropMgr.Set(属性, 自制