SolidWorks机械工程师网——最大的SolidWorks学习平台

标题: 2个宏合并为1个宏出现错误 [打印本页]
作者: nmimi    时间: 2021-6-21 17:11
标题: 2个宏合并为1个宏出现错误
自定义属性宏：
  1. Sub main()
  2. Set swApp = Application.SldWorks
  3. Set swModel = swApp.ActiveDoc
  4. Set cpm = swModel.Extension.CustomPropertyManager("")
  5. vCustInfoNameArr2 = swModel.GetCustomInfoNames
  6.   If Not IsEmpty(vCustInfoNameArr2) Then
  7.      For Each vCustInfoName2 In vCustInfoNameArr2
  8.          bRet = swModel.DeleteCustomInfo(vCustInfoName2)
  9.       Next
  10.     End If

  12. Set swApp = Application.SldWorks
  13. Set Part = swApp.ActiveDoc
  14. CurCFGname = Part.GetConfigurationNames
  15. CurCFGnameCount = Part.GetConfigurationCount
  16. For i = 0 To CurCFGnameCount - 1
  17.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
  18.     Vnamearr = CusPropMgr.GetNames
  19.     If Not IsEmpty(Vnamearr) Then
  20.         For Each Vnamearr2 In Vnamearr
  21.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
  22.         Next
  23.     End If

  25. Dim PartName As String
  26. Set swApp = Application.SldWorks
  27. Set swModel = swApp.ActiveDoc
  28. PartName = swApp.ActiveDoc.GetTitle() '获取零件图名称

  30. blnretval = swModel.DeleteCustomInfo2("", "材料")
  31. blnretval = swModel.DeleteCustomInfo2("", "钣金厚度")
  32. blnretval = swModel.DeleteCustomInfo2("", "质量")
  33. blnretval = swModel.DeleteCustomInfo2("", "体积")
  34. blnretval = swModel.DeleteCustomInfo2("", "表面积")
  35. blnretval = swModel.DeleteCustomInfo2("", "表面处理")
  36. blnretval = swModel.DeleteCustomInfo2("", "数量")
  37. blnretval = swModel.DeleteCustomInfo2("", "工序1")
  38. blnretval = swModel.DeleteCustomInfo2("", "工序2")
  39. blnretval = swModel.DeleteCustomInfo2("", "工序3")
  40. blnretval = swModel.DeleteCustomInfo2("", "工序4")
  41. blnretval = swModel.DeleteCustomInfo2("", "工序5")
  42. blnretval = swModel.DeleteCustomInfo2("", "备注")
  43. blnretval = swModel.DeleteCustomInfo2("", "折弯半径")
  44. blnretval = swModel.DeleteCustomInfo2("", "折弯系数")
  45. blnretval = swModel.DeleteCustomInfo2("", "型材长度")

  47. blnretval = swModel.AddCustomInfo3("", "材料", swCustomInfoText, """SW-Material""")
  48. blnretval = swModel.AddCustomInfo3("", "钣金厚度", swCustomInfoText, "T""厚度@钣金""")
  49. blnretval = swModel.AddCustomInfo3("", "质量", swCustomInfoText, """SW-Mass""")
  50. blnretval = swModel.AddCustomInfo3("", "体积", swCustomInfoText, """SW-Volume""")
  51. blnretval = swModel.AddCustomInfo3("", "表面积", swCustomInfoText, """SW-SurfaceArea""")
  52. blnretval = swModel.AddCustomInfo3("", "表面处理", swCustomInfoText, "")
  53. blnretval = swModel.AddCustomInfo3("", "数量", swCustomInfoText, "1")
  54. blnretval = swModel.AddCustomInfo3("", "工序1", swCustomInfoText, "2D激光")
  55. blnretval = swModel.AddCustomInfo3("", "工序2", swCustomInfoText, "折弯")
  56. blnretval = swModel.AddCustomInfo3("", "工序3", swCustomInfoText, "氩焊")
  57. blnretval = swModel.AddCustomInfo3("", "工序4", swCustomInfoText, "")
  58. blnretval = swModel.AddCustomInfo3("", "工序5", swCustomInfoText, "")
  59. blnretval = swModel.AddCustomInfo3("", "备注", swCustomInfoText, "")
  60. blnretval = swModel.AddCustomInfo3("", "折弯半径", swCustomInfoText, """D1@钣金""")
  61. blnretval = swModel.AddCustomInfo3("", "折弯系数", swCustomInfoText, """D2@钣金""")
  62. blnretval = swModel.AddCustomInfo3("", "型材长度", swCustomInfoText, """LENGTH@@@切割清单项目1@零件""")
  63. Next
  64. End Sub
复制代码
图号分离写入自定义属性宏：
  1. '定义solidwork
  2. Dim swApp As Object
  3. Dim Part As Object
  4. Dim SelMgr As Object
  5. Dim boolstatus As Boolean
  6. Dim longstatus As Long, longwarnings As Long
  7. Dim Feature As Object


  10. Dim a As Integer
  11. Dim b As String
  12. Dim m As String
  13. Dim e As String
  14. Dim k As String
  15. Dim t As String
  16. Dim c As String
  17. Dim j As Integer
  18. Dim strmat As String
  19. Dim tempvalue As String
  20. Sub main()
  21. Set swApp = CreateObject("sldworks.application")
  22. Set Part = swApp.ActiveDoc
  23. swApp.ActiveDoc.ActiveView.FrameState = 1
  24. Set CurCFG = Part.GetActiveConfiguration()
  25. ConfName = CurCFG.Name
  26. Name = swApp.ActiveDoc.GetTitle()
  27.   c = Replace(Name, " ", "")
  28. blnretval = Part.DeleteCustomInfo2("", "代号")
  29. blnretval = Part.DeleteCustomInfo2("", "名称")
  30.    b = Len(c)
  31.    e = Right(c, 7)
  32. If e = ".SLDPRT" Or e = ".SLDASM" Or e = ".sldprt" Or e = ".sldasm" Then
  33.    f = Left(c, b - 7)
  34. Else
  35.    f = c
  36. End If
  37. k = Len(f)
  38. kk = LenB(StrConv(f, vbFromUnicode))
  39. If k = kk Then '纯数字的情况
  40.     s = ""
  41.     t = f
  42. Else
  43.     If kk / k = 2 Then  '纯汉字的情况
  44.         t = ""
  45.         s = f
  46.     Else
  47.         For i = 1 To k
  48.             If Asc(Mid$(f, i, 1)) < 0 Then
  49.                 w = i '确定第一个汉字的位置
  50.         Exit For
  51.             End If
  52.         Next
  53.         If w = 1 Then                '名称+代号的情况
  54.             s = Left(f, kk - k)
  55.             t = Right(f, k - (kk - k))
  56.         Else                         '代号+名称的情况
  57.             s = Right(f, k - w + 1)
  58.             t = Left(f, w - 1)
  59.         End If
  60.     End If
  61. End If
  62. blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, t)
  63. blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, s)
  64. End Sub
复制代码
合并有错误，求大神指点。
作者: 515109201    时间: 2021-6-22 16:13
对象不一致，前面是swModel，后面是Part
作者: nmimi    时间: 2021-6-23 14:01
515109201 发表于 2021-6-22 16:13
对象不一致，前面是swModel，后面是Part

求合并。。。。。。。。。。。。
作者: redfrog    时间: 2021-6-24 12:10
SolidWorks机械工程师网，顶一下。
作者: YU7630    时间: 2022-5-12 13:47
求合并。。。。。。。。。。。。



欢迎光临 SolidWorks机械工程师网——最大的SolidWorks学习平台 (https://www.swbbsc.com/) Powered by Discuz! X3.2