2. 将里面的文字全部删除,并将下列代码复制进去并保存为:“图号分离-宏”;
'定义solidwork
Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String
Sub main()
'link SOLIDWORKS
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1 '重点:分隔标识符,这里是一个空格
If a > 0 Then
k = Left(c, a)
t = Left(LTrim(e), 3)
If t = "GBT" Then
e = "GB/T" + Mid(k, 4)
Else
e = k
End If
b = Mid(c, a + 2)
t = Right(c, 7)
If t = ".SLDPRT" Or t = ".SLDASM" Then
j = Len(b) - 7
Else
j = Len(b)
End If
m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e) '代号
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m) '名称
blnretval = Part.AddCustomInfo3("", "表面处理", swCustomInfoText, " ")
End Sub
3. 按照上面同样的步骤再次新建一个宏命令,命名为“AutoRun”;删除红色框中所有代码,并将下列代码复制进去。
Public AutoRun As 类1
Sub main()
Set AutoRun = New 类1
End Sub
4. 右键左边资源管理器,选择插入类模块,并将下列代发复制进去,保存宏;
Private WithEvents SwApp As SldWorks.SldWorks
Private Sub Class_Initialize()
Set SwApp = Application.SldWorks
End Sub
Private Function SwApp_ActiveModelDocChangeNotify() As Long
Dim runMacroError As Long
SwApp.RunMacro2 "C:\Macros\图号分离-宏.swp", "图号分离_宏1", "main", 0, runMacroError
End Function
5. 在C盘新建文件夹,命名Macros,将附件的两个.swp文件放到上面新建的Macros文件夹中;
6. 右键桌面选择SOLIDWORKS图标 ,选择属性