设为首页收藏本站
开启辅助访问 切换到宽版

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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

SolidWorks机械工程师网——最大的SolidWorks学习平台»学习社区 › SolidWorks开发与拓展应用 › SolidWorks二次开发（宏，VBA） › 2个宏合并为1个宏出现错误
返回列表 发新帖
查看: 2353|回复: 4
打印 上一主题 下一主题

2个宏合并为1个宏出现错误

  [复制链接]
nmimi

19

主题

128

帖子

80

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1392

最佳新人活跃会员热心会员宣传达人灌水之王
跳转到指定楼层
楼主
 楼主| 发表于 2021-6-21 17:11:46 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式

   经典图书
自定义属性宏：
  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
复制代码
合并有错误，求大神指点。
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 转播转播 分享教程|习题|模型|技巧 点赞点赞 拍砖拍砖
SolidWorks机械工程师网
提示：建议使用谷歌浏览器浏览本网站！如单击这里下载！否则，可能无法下载附件文件！（支持大多数版本的谷歌浏览器，支持360和QQ浏览器的极速模式，即谷歌内核模式，使用IE和Edge浏览器，浏览个别网页以及下载文件时，会误报“***不安全”，此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载，另外，本网站不含任何不安全的文件，已联系微软公司解决，纯属IE和Edge浏览器误报）
回复

使用道具 举报

515109201

1

主题

46

帖子

110

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1250

最佳新人活跃会员宣传达人
沙发
发表于 2021-6-22 16:13:51 | 只看该作者
对象不一致，前面是swModel，后面是Part
SolidWorks机械工程师网
提示：建议使用谷歌浏览器浏览本网站！如单击这里下载！否则，可能无法下载附件文件！（支持大多数版本的谷歌浏览器，支持360和QQ浏览器的极速模式，即谷歌内核模式，使用IE和Edge浏览器，浏览个别网页以及下载文件时，会误报“***不安全”，此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载，另外，本网站不含任何不安全的文件，已联系微软公司解决，纯属IE和Edge浏览器误报）
回复 支持 反对

使用道具 举报

nmimi

19

主题

128

帖子

80

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1392

最佳新人活跃会员热心会员宣传达人灌水之王
板凳
 楼主| 发表于 2021-6-23 14:01:29 | 只看该作者

   经典图书
515109201 发表于 2021-6-22 16:13
对象不一致，前面是swModel，后面是Part

求合并。。。。。。。。。。。。
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

redfrog

2

主题

11

帖子

193

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
297
QQ
地板
发表于 2021-6-24 12:10:40 | 只看该作者
SolidWorks机械工程师网，顶一下。
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

YU7630

2

主题

553

帖子

19

金币

传奇

Rank: 8Rank: 8

积分
3905

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
5#
发表于 2022-5-12 13:47:35 | 只看该作者

   经典案例图书
求合并。。。。。。。。。。。。
SolidWorks机械工程师网
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

关闭 卷起
关闭 卷起

SOLIDWORKS 2023 机械设计从入门到精通

手机版|小黑屋| GMT+8, 2024-9-23 00:33 , Processed in 0.150621 second(s), 23 queries , Memcache On.

SolidWorks机械工程师网 ( 鲁ICP备14025122号-2 ) 鲁公网安备 37028502190335号

声明：本网言论纯属发表者个人意见，与本网立场无关。
如涉版权，可发邮件： admin@swbbsc.com

快速回复 返回顶部 返回列表