找回密码 注册 QQ登录
一站式解决方案

iCAx开思网

CAD/CAM/CAE/设计/模具 高清视频【积分说明】如何快速获得积分?快速3D打印 手板模型CNC加工服务在线3D打印服务,上传模型,自动报价
查看: 8891|回复: 32
打印 上一主题 下一主题

[求助] 【遍历宏】在总装配內零件的自定义属性写入页码

[复制链接]
跳转到指定楼层
1
发表于 2018-2-24 00:47:51 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
  1. 由于平时需要在工程图中填写页码(底图张次),于是在闷大“【遍历宏】在总装配內零件的自定义属性写入配套数量”一贴的基础上修改为写入页码,页码是都填写出来,可是它不一定按总装设计树的顺序编号,有点随机,以下代码不知道能否修改一下,使得页码按总装设计树的顺序编号?请教各位大侠!
复制代码
  1. Dim TopDocPathOnly As String
  2. Dim PartsCollect() As String    '遍历清单(阵列)
  3. Dim InCollectCount As Double    '遍历清单长度
  4. Dim CustomInfoQTY  As String

  5. '*******************************************************
  6. Dim Page_Qty           As String
  7. Dim Page_Pre           As String
  8. Dim swApp              As SldWorks.SldWorks
  9. Dim swModelDoc         As SldWorks.ModelDoc2
  10. Dim swConfig           As SldWorks.Configuration
  11. Dim CustPrOPMgr        As SldWorks.CustomPropertyManager

  12. Sub main()

  13. Answer = MsgBox("① 本程序将遍历装配体填写“页码”属性,请确认顶层装配体已保存!" & Chr(13) & "② 不在顶层装配体目录或子目录、压缩、轻化、虚拟、封套、不包括在BOM中的零部件不作处理。", vbOKCancel + 48)
  14. If Answer = vbOK Then
  15.   Set swApp = Application.SldWorks        'SW对象
  16.   Set TopDoc = swApp.ActiveDoc            '顶层装配体对象
  17.   If TopDoc.GetType <> 2 Then Exit Sub    '如果不是装配体则退出
  18.   TopDocPathSplit = Split(TopDoc.GetPathName, "")         '分割
  19.   TopDocName = TopDocPathSplit(UBound(TopDocPathSplit))    '顶层装配体文件名称
  20.   TopDocName = Left(TopDocName, Len(TopDocName) - 7)       '顶层装配体文件名称(排除.SLDASM)
  21.   TopDocPathOnly = Mid(TopDoc.GetPathName, 1, InStrRev(TopDoc.GetPathName, "", -1))    '顶层装配体的完整目录
  22.   TopConfString = TopDoc.GetActiveConfiguration.Name       '顶层装配体配置名称
  23.   CustomInfoQTY = "配套数量"                               '可根据需要改为其它
  24.   Page_Qty = 1                            '页码递增基数
  25.   InCollectCount = 1                      '遍历清单长度基数
  26.   ReDim PartsCollect(InCollectCount)      '定义阵列项数
  27. Else: Exit Sub
  28. End If

  29. '*******************************************************
  30. Page_Pre = InputBox("输入页码前缀再按“确定”,无前缀请按任意键。")
  31. Set TopCustPropMgr = TopDoc.Extension.CustomPropertyManager("")
  32. TopCustPropMgr.Delete ("页码")
  33. TopCustPropMgr.Add2 "页码", swCustomInfoText, Page_Pre & "" & "1"             '指定顶层装配体的页码为“1”
  34. '*******************************************************

  35. SubAsm TopDoc, TopConfString     '遍历

  36. Beep    '响铃

  37. End Sub

  38. Function SubAsm(AsmDoc, ConfString)

  39. Set Configuration = AsmDoc.GetConfigurationByName(ConfString)
  40. Set RootComponent = Configuration.GetRootComponent
  41. Components = RootComponent.GetChildren
  42. For Each Child In Components
  43.     Set ChildModel = Child.GetModelDoc
  44.     If Not (ChildModel Is Nothing) Then    '排除压缩及轻化
  45.         ChildConfString = Child.ReferencedConfiguration    '零件配置名称
  46.         ChildType = ChildModel.GetType
  47.         ChildPathSplit = Split(Child.GetPathName, "")     '分割
  48.         ChildName = ChildPathSplit(UBound(ChildPathSplit)) '零件文件名称

  49.         ChildPathOnly = Mid(Child.GetPathName, 1, InStrRev(Child.GetPathName, "", -1))  '零件的完整目录
  50.         If ChildPathOnly = Replace(ChildPathOnly, TopDocPathOnly, "") Then SamePath = False Else SamePath = True    '零件是否在顶层装配体目录或子目录中

  51.         If SamePath And (Not Child.ExcludeFromBOM) And (Not Child.IsEnvelope) Then       '跳过:不在顶层装配体目录或子目录 及 不包括在BOM中 及 封套
  52.         'If (Not Child.ExcludeFromBOM) And (Not Child.IsEnvelope) Then                    '跳过:不包括在BOM中 及 封套
  53.             UNIT_OF_MEASURE_Name = ChildModel.CustomInfo2("", "UNIT_OF_MEASURE")         '备用量属性名称
  54.             UNIT_OF_MEASURE = ChildModel.CustomInfo2("", UNIT_OF_MEASURE_Name)           '备用量
  55.             If (UNIT_OF_MEASURE = 0) Or (UNIT_OF_MEASURE = "") Then UNIT_OF_MEASURE = 1  '备用量除错
  56.             inCollect = False    '重置判断变量
  57.             For Each PartinCollect In PartsCollect    '判断是否已在遍历清单内
  58.                 If "" & "@" & ChildName = PartinCollect Then inCollect = True
  59.             Next
  60.             If inCollect Then    '已在遍历清单内
  61. '                ht_Qty = ChildModel.CustomInfo2("", CustomInfoQTY) + 1 * UNIT_OF_MEASURE
  62. '                ChildModel.DeleteCustomInfo2 "", CustomInfoQTY
  63. '                ChildModel.AddCustomInfo3 "", CustomInfoQTY, 30, ht_Qty
  64.             Else                 '不在遍历清单内(首次处理)
  65. '                ChildModel.DeleteCustomInfo2 "", CustomInfoQTY
  66. '                ChildModel.AddCustomInfo3 "", CustomInfoQTY, 30, UNIT_OF_MEASURE
  67.                 InCollectCount = InCollectCount + 1            '遍历清单长度基数+1
  68.                 ReDim Preserve PartsCollect(InCollectCount)    '重新定义阵列项数(保留内含数据)
  69.                 PartsCollect(InCollectCount - 1) = "" & "@" & ChildName    '加入到遍历清单中

  70.                 '*******************************************************
  71.                 Set CustPropMgr = ChildModel.Extension.CustomPropertyManager("")
  72.                 Page_Qty = Page_Qty + 1
  73.                 ChildModel.DeleteCustomInfo2 "", ("页码")
  74.                 ChildModel.AddCustomInfo3 "", ("页码"), 30, Page_Pre & Page_Qty
  75.                 '*******************************************************

  76.                 ChildModel.SketchManager.Insert3DSketch True     '插入3D草图,从而激活零件的“需存盘标签”
  77.                 ChildModel.SketchManager.Insert3DSketch True     '离开3D草图

  78.             End If
  79.             If ChildType = 2 Then
  80.                 SubAsm ChildModel, ChildConfString               '如果是装配体则向下遍历
  81.             End If

  82.         End If
  83.     End If
  84. Next

  85. End Function
复制代码


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏6 分享淘帖 赞一下!赞一下!
2
发表于 2018-2-24 15:26:47 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
3
 楼主| 发表于 2018-2-24 18:38:12 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
4
发表于 2018-2-26 13:44:28 | 只看该作者

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
5
发表于 2018-2-26 14:18:57 | 只看该作者

放羊:球面写字

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
6
发表于 2018-2-26 14:20:24 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
7
 楼主| 发表于 2018-2-26 21:27:34 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
8
 楼主| 发表于 2018-2-26 21:46:47 | 只看该作者

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
9
发表于 2018-2-28 13:58:17 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
10
发表于 2018-2-28 14:02:57 | 只看该作者

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

3D打印手板模型快速制作服务,在线报价下单!

QQ 咨询|手机版|联系我们|iCAx开思网  

GMT+8, 2024-11-5 22:27 , Processed in 0.030618 second(s), 13 queries , Gzip On, Redis On.

Powered by Discuz! X3.3

© 2002-2024 www.iCAx.org

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