|
经典图书 自定义属性宏:
- Sub main()
- Set swApp = Application.SldWorks
- Set swModel = swApp.ActiveDoc
- Set cpm = swModel.Extension.CustomPropertyManager("")
- vCustInfoNameArr2 = swModel.GetCustomInfoNames
- If Not IsEmpty(vCustInfoNameArr2) Then
- For Each vCustInfoName2 In vCustInfoNameArr2
- bRet = swModel.DeleteCustomInfo(vCustInfoName2)
- Next
- End If
- Set swApp = Application.SldWorks
- Set Part = swApp.ActiveDoc
- 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
- bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
- Next
- End If
- Dim PartName As String
- Set swApp = Application.SldWorks
- Set swModel = swApp.ActiveDoc
- PartName = swApp.ActiveDoc.GetTitle() '获取零件图名称
- blnretval = swModel.DeleteCustomInfo2("", "材料")
- blnretval = swModel.DeleteCustomInfo2("", "钣金厚度")
- blnretval = swModel.DeleteCustomInfo2("", "质量")
- blnretval = swModel.DeleteCustomInfo2("", "体积")
- blnretval = swModel.DeleteCustomInfo2("", "表面积")
- blnretval = swModel.DeleteCustomInfo2("", "表面处理")
- blnretval = swModel.DeleteCustomInfo2("", "数量")
- blnretval = swModel.DeleteCustomInfo2("", "工序1")
- blnretval = swModel.DeleteCustomInfo2("", "工序2")
- blnretval = swModel.DeleteCustomInfo2("", "工序3")
- blnretval = swModel.DeleteCustomInfo2("", "工序4")
- blnretval = swModel.DeleteCustomInfo2("", "工序5")
- blnretval = swModel.DeleteCustomInfo2("", "备注")
- blnretval = swModel.DeleteCustomInfo2("", "折弯半径")
- blnretval = swModel.DeleteCustomInfo2("", "折弯系数")
- blnretval = swModel.DeleteCustomInfo2("", "型材长度")
- blnretval = swModel.AddCustomInfo3("", "材料", swCustomInfoText, """SW-Material""")
- blnretval = swModel.AddCustomInfo3("", "钣金厚度", swCustomInfoText, "T""厚度@钣金""")
- blnretval = swModel.AddCustomInfo3("", "质量", swCustomInfoText, """SW-Mass""")
- blnretval = swModel.AddCustomInfo3("", "体积", swCustomInfoText, """SW-Volume""")
- blnretval = swModel.AddCustomInfo3("", "表面积", swCustomInfoText, """SW-SurfaceArea""")
- blnretval = swModel.AddCustomInfo3("", "表面处理", swCustomInfoText, "")
- blnretval = swModel.AddCustomInfo3("", "数量", swCustomInfoText, "1")
- blnretval = swModel.AddCustomInfo3("", "工序1", swCustomInfoText, "2D激光")
- blnretval = swModel.AddCustomInfo3("", "工序2", swCustomInfoText, "折弯")
- blnretval = swModel.AddCustomInfo3("", "工序3", swCustomInfoText, "氩焊")
- blnretval = swModel.AddCustomInfo3("", "工序4", swCustomInfoText, "")
- blnretval = swModel.AddCustomInfo3("", "工序5", swCustomInfoText, "")
- blnretval = swModel.AddCustomInfo3("", "备注", swCustomInfoText, "")
- blnretval = swModel.AddCustomInfo3("", "折弯半径", swCustomInfoText, """D1@钣金""")
- blnretval = swModel.AddCustomInfo3("", "折弯系数", swCustomInfoText, """D2@钣金""")
- blnretval = swModel.AddCustomInfo3("", "型材长度", swCustomInfoText, """LENGTH@@@切割清单项目1@零件""")
- Next
- End Sub
复制代码 图号分离写入自定义属性宏:
- '定义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()
- Set swApp = CreateObject("sldworks.application")
- Set Part = swApp.ActiveDoc
- swApp.ActiveDoc.ActiveView.FrameState = 1
- Set CurCFG = Part.GetActiveConfiguration()
- ConfName = CurCFG.Name
- Name = swApp.ActiveDoc.GetTitle()
- c = Replace(Name, " ", "")
- blnretval = Part.DeleteCustomInfo2("", "代号")
- blnretval = Part.DeleteCustomInfo2("", "名称")
- b = Len(c)
- e = Right(c, 7)
- If e = ".SLDPRT" Or e = ".SLDASM" Or e = ".sldprt" Or e = ".sldasm" Then
- f = Left(c, b - 7)
- Else
- f = c
- End If
- k = Len(f)
- kk = LenB(StrConv(f, vbFromUnicode))
- If k = kk Then '纯数字的情况
- s = ""
- t = f
- Else
- If kk / k = 2 Then '纯汉字的情况
- t = ""
- s = f
- Else
- For i = 1 To k
- If Asc(Mid$(f, i, 1)) < 0 Then
- w = i '确定第一个汉字的位置
- Exit For
- End If
- Next
- If w = 1 Then '名称+代号的情况
- s = Left(f, kk - k)
- t = Right(f, k - (kk - k))
- Else '代号+名称的情况
- s = Right(f, k - w + 1)
- t = Left(f, w - 1)
- End If
- End If
- End If
- blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, t)
- blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, s)
- End Sub
复制代码 合并有错误,求大神指点。
|
|