|
经典图书 Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Part As SldWorks.PartDoc
Dim vCustInfoNameArr2, vCustInfoName2 As Variant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swModel
'删除所有属性
vCustInfoNameArr2 = swModel.GetCustomInfoNames
If Not IsEmpty(vCustInfoNameArr2) Then
For Each vCustInfoName2 In vCustInfoNameArr2
swModel.DeleteCustomInfo vCustInfoName2
Next
End If
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
Vnamearr = CusPropMgr.GetNames
If Not IsEmpty(Vnamearr) Then
For Each Vnamearr2 In Vnamearr
Part.DeleteCustomInfo2 CurCFGname(i), Vnamearr2
Next
End If
Next
'设置单位为"自定义"
swModel.Extension.SetUserPreferenceInteger 263, 0, 4 '设置单位为"自定"
swModel.Extension.SetUserPreferenceInteger 259, 0, 3 '最后一个值,1毫克,2克,3千克,4镑
swModel.Extension.SetUserPreferenceInteger 258, 0, 2 '长度
swModel.Extension.SetUserPreferenceInteger 260, 0, 6 '体积
swModel.ClearSelection2 True
swModel.Save '存档
'图号分离
swApp.ActiveDoc.ActiveView.FrameState = 1
Set CurCFG = Part.GetActiveConfiguration()
ConfName = CurCFG.Name
Name = swApp.ActiveDoc.GetTitle()
c = InStr(Name, " ") - 1 '重点:分隔标识符,这里是一个空格,也可用其他符号区分
If c > 0 Then
t = Left(Name, c)
b = Mid(Name, c + 2)
e = Right(Name, 7)
If e = ".SLDPRT" Or e = ".SLDASM" Or e = ".sldprt" Or e = ".sldasm" Then
j = Len(b) - 7 '消除后缀(区分大小写,即含4种)
Else
j = Len(b)
End If
s = Left(b, j)
Else
e = Right(Name, 7)
If e = ".SLDPRT" Or e = ".SLDASM" Or e = ".sldprt" Or e = ".sldasm" Then
j = Len(Name) - 7 '消除后缀(区分大小写,即含4种)
Else
j = Len(Name)
End If
t = Left(Name, j)
s = ""
End If
'swModel.AddCustomInfo3 "", "图号", swCustomInfoText, t
'swModel.AddCustomInfo3 "", "名称", swCustomInfoText, s
'设置属性,赋默认值
swModel.AddCustomInfo3 "", "图号", swCustomInfoText, t
swModel.AddCustomInfo3 "", "名称", swCustomInfoText, s
Part.EditRebuild3
swModel.Save
Set swApp = Application.SldWorks
End Sub
|
|