|
图号分离(分离到配置特定里),原则同上。
'????sw
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
Dim Part As Object
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swConfig As SldWorks.Configuration
Dim CustPropMgr As SldWorks.CustomPropertyManager
Dim swModel As SldWorks.ModelDoc2
Sub main()
Set swApp = Application.SldWorks
Set swModelDoc = swApp.ActiveDoc
Set swConfig = swModelDoc.ConfigurationManager.ActiveConfiguration
Set swModel = swApp.ActiveDoc
Set CustPropMgr = swModel.Extension.CustomPropertyManager(swModel.ConfigurationManager.ActiveConfiguration.Name) '???????????
'?趨????
c = swApp.ActiveDoc.GetTitle() '?????
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
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" Or t = ".sldprt" Or t = ".sldasm" Then
j = Len(b) - 7 '??????????????Сд??????4???
Else
j = Len(b)
End If
m = Left(b, j)
End If
'?????
CustPropMgr.Delete ("Number")
CustPropMgr.Delete ("????")
CustPropMgr.Delete ("????")
CustPropMgr.Delete ("???????")
CustPropMgr.Delete ("?????")
CustPropMgr.Delete ("???")
CustPropMgr.Delete ("???????")
CustPropMgr.Delete ("???????-")
CustPropMgr.Delete ("Material-")
'????
CustPropMgr.Add2 "Number", swCustomInfoText, e
CustPropMgr.Add2 "????", swCustomInfoText, "????qq420221716"
CustPropMgr.Add2 "???????", swCustomInfoText, m
End Sub |
|