Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim cpm As CustomPropertyManager
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set cpm = swModel.Extension.CustomPropertyManager("")
Dim path As String, filename As String, partno As String, desc As String
path = swModel.GetPathName 'Get the Path name + File Name
filename = Mid$(path, InStrRev(path, "\") + 1) ' File Name With extension
filename = Left$(filename, InStrRev(filename, ".") - 1) ' Remove extension
partno = Left(filename, 10) ' Get the Left 10 digit string as part number
desc = Right(filename, Len(filename) - 10) ' Get remaining string as part description
cpm.Delete "PartNo" ' Delete the old custom properties if exist
cpm.Delete "Description" ' Delete the old custom properties if exist
cpm.Add2 "PartNo", swCustomInfoText, partno ' write new value into custom properties
cpm.Add2 "Description", swCustomInfoText, desc' write new value into custom properties
End Sub作者: linsd 时间: 2009-3-30 23:47
[attach]899854[/attach]
