自己在用的图号分离、删除所有属性、单位，差不多5、6个宏合并到一个宏，求指导优化

nmimi · 发表于 2021-6-24 09:14:43

自己在用的图号分离、删除所有属性、单位，差不多5、6个宏合并到一个宏，求指导优化。

Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Part As SldWorks.PartDoc
Dim vCustInfoNameArr2, vCustInfoName2 As Variant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swModel
'删除所有属性
vCustInfoNameArr2 = swModel.GetCustomInfoNames
If Not IsEmpty(vCustInfoNameArr2) Then
For Each vCustInfoName2 In vCustInfoNameArr2
swModel.DeleteCustomInfo vCustInfoName2
Next
End If
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
Part.DeleteCustomInfo2 CurCFGname(i), Vnamearr2
Next
End If
Next
'设置单位为"自定义"
swModel.Extension.SetUserPreferenceInteger 263, 0, 4 '设置单位为"自定"
swModel.Extension.SetUserPreferenceInteger 259, 0, 3 '最后一个值，1毫克，2克，3千克，4镑
swModel.Extension.SetUserPreferenceInteger 258, 0, 2 '长度
swModel.Extension.SetUserPreferenceInteger 260, 0, 6 '体积
swModel.ClearSelection2 True
swModel.Save '存档
'展开长宽
Dim swFeature As SldWorks.Feature
Dim FeatName As String
Dim FeatType As String
Set swFeature = swModel.FirstFeature
While Not swFeature Is Nothing '遍历零件FeatureManager并获取特征和属性
FeatName = swFeature.Name '获取特征名称
FeatType = swFeature.GetTypeName '获取特征属性
If FeatType = "CutListFolder" Then
swFeature.Name = "切割清单项目" '修改名称
End If
Set swFeature = swFeature.GetNextFeature
Wend
'swModel.AddCustomInfo3 "", "长", swCustomInfoText, """SW-边界框长度@@@切割清单项目@零件.SLDPRT""" 'VB语法，两个引号组成一个引号
'swModel.AddCustomInfo3 "", "宽", swCustomInfoText, """SW-边界框宽度@@@切割清单项目@零件.SLDPRT"""
'图号分离
swApp.ActiveDoc.ActiveView.FrameState = 1
Set CurCFG = Part.GetActiveConfiguration()
ConfName = CurCFG.Name
Name = swApp.ActiveDoc.GetTitle()
c = Replace(Name, " ", "")
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
'swModel.AddCustomInfo3 "", "图号", swCustomInfoText, t
'swModel.AddCustomInfo3 "", "名称", swCustomInfoText, s
'删除以下值
blnretval = swModel.DeleteCustomInfo2("", "成型规格")
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("", "K因子")
blnretval = swModel.DeleteCustomInfo2("", "型材长度")
'设置属性,赋默认值
swModel.AddCustomInfo3 "", "图号", swCustomInfoText, t
swModel.AddCustomInfo3 "", "名称", swCustomInfoText, s
blnretval = swModel.AddCustomInfo3("", "材质", swCustomInfoText, """SW-Material""")
blnretval = swModel.AddCustomInfo3("", "钣金厚度", swCustomInfoText, """厚度@钣金""")
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("", "K因子", swCustomInfoText, """D2@钣金""")
swModel.AddCustomInfo3 "", "展开长", swCustomInfoText, """SW-边界框长度@@@切割清单项目@零件.SLDPRT"""
swModel.AddCustomInfo3 "", "展开宽", swCustomInfoText, """SW-边界框宽度@@@切割清单项目@零件.SLDPRT"""
blnretval = swModel.AddCustomInfo3("", "型材长度", swCustomInfoText, "")
swModel.Save
End Sub

复制代码

nmimi · 发表于 2021-6-24 09:32:41

1，此宏是根据多个宏整合的，存在遍历重复现象，
2，有的属性写入自定义属性，有的写入配置特定属性，全部整合统一写入自定义属性，花了些时间的，
3，开头就是删除已有的自定义属性、配置特定属性，
4，设置单位为自定义，强制设置重量为千克，体积为立方米，表面积为平方米，
5，钣金展开长宽，
6，图号分离，不管哪种情况的图号都能分离，只有中文的全部写入名称，只有英文+数字的全部写入图号，
7，删除值，不知道什么作用，但不可缺少，
8，写入自定义属性，
9，写入完成后，自动保存零件。
可按需求删减。求大神优化。

yni621 · 发表于 2021-6-24 11:57:56

感谢楼主分享，很不错！

yni621 · 发表于 2021-6-24 16:40:23

折弯系数，展开长，经常连接不上切割清单项目，知道是什么问题吗？
偶尔有些图纸可以连接上有数字，经常都是链接不上，就显示"SW-折弯系数@@@切割清单项目@AA00 JI AADD.SLDPRT"

tg000057 · 发表于 2021-6-24 17:31:18

经典案例图书

yni621 发表于 2021-6-24 16:40
折弯系数，展开长，经常连接不上切割清单项目，知道是什么问题吗？
偶尔有些图纸可以连接上有数字，经常都 ...

sw版本问题，sw2018以上的版本创建的文档，可以这样获取切割清单数据，在其之下的版本就链接不上，不然论坛也不会出现那么多，获取切割清单数据的贴了。

nmimi · 发表于 2021-6-24 19:04:18

yni621 发表于 2021-6-24 16:40
折弯系数，展开长，经常连接不上切割清单项目，知道是什么问题吗？
偶尔有些图纸可以连接上有数字，经常都 ...

尝试把切割清单项目改成sheet

蒲公英 · 发表于 2021-6-25 00:00:59

经典案例图书

很好的东西，谢谢分享这些代码!

yni621 · 发表于 2021-6-25 09:42:15

nmimi 发表于 2021-6-24 19:04
尝试把切割清单项目改成sheet

昨天我就发现是这个，很多切割清单项目，后面多了1，或者没有，我看你的是自动更改为切割清单项目，所以能读取，单独版本这个宏还是挺好用的。

nmimi · 发表于 2021-6-25 10:05:15

yni621 发表于 2021-6-25 09:42
昨天我就发现是这个，很多切割清单项目，后面多了1，或者没有，我看你的是自动更改为切割清单项目，所以 ...

有什么好的宏分享一下

Allate · 发表于 2021-6-25 10:16:09

tg000057 发表于 2021-6-24 17:31
sw版本问题，sw2018以上的版本创建的文档，可以这样获取切割清单数据，在其之下的版本就链接不上，不然论 ...

估计是SW2021才能这样链接，我只有19的，就不凑合了。

yni621 · 发表于 2021-6-25 13:38:47

nmimi 发表于 2021-6-25 10:05
有什么好的宏分享一下

都是下版主的宏用，能用的他都汇总了，你那个改单位的宏也是他出的，把他汇总你的宏里面。

yni621 · 发表于 2021-6-25 13:40:49

tg000057 发表于 2021-6-24 17:31
sw版本问题，sw2018以上的版本创建的文档，可以这样获取切割清单数据，在其之下的版本就链接不上，不然论 ...

我的版本没问题，不过你说的也有道理，2018以上才有，之前的没这个功能，
Dim swFeature As SldWorks.Feature
Dim FeatName As String
Dim FeatType As String
Set swFeature = swModel.FirstFeature
While Not swFeature Is Nothing '遍历零件FeatureManager并获取特征和属性
FeatName = swFeature.Name '获取特征名称
FeatType = swFeature.GetTypeName '获取特征属性
If FeatType = "CutListFolder" Then
swFeature.Name = "切割清单项目" '修改名称
End If
主要是这个代码，他默认把切割清单项目修改名称，所以能链接上，其他我就看不懂了。

yni621 · 发表于 2021-6-25 13:43:23

tg000057 发表于 2021-6-24 17:31
sw版本问题，sw2018以上的版本创建的文档，可以这样获取切割清单数据，在其之下的版本就链接不上，不然论 ...

T大，我想知道
blnretval = swModel.AddCustomInfo3
swModel.AddCustomInfo3
两个代码有什么区别，我看了很多图号分离的文件，都有这两个代码，楼主这个版本就两个都用上了，其他都是只能用一个，换了就不能用。

tg000057 · 发表于 2021-6-25 14:27:11

Allate 发表于 2021-6-25 10:16
估计是SW2021才能这样链接，我只有19的，就不凑合了。

我的也是19版的，升级前是17版的，当初想用这样链接，还觉得方便，后来发现旧文档用不了，有点晕。

tg000057 · 发表于 2021-6-25 14:28:37

加入QQ群
参与讨论和学习

或扫描二维码加入

yni621 发表于 2021-6-25 13:43
T大，我想知道
blnretval = swModel.AddCustomInfo3
swModel.AddCustomInfo3

我觉得是一样的啊，你可以自己换着试试看有什么区别啊。

qqfly332211 · 发表于 2021-10-7 08:05:52

经典案例图书

活到老学到老！

淡淡的雲 · 发表于 2021-10-7 08:55:18

加入QQ群
参与讨论和学习

或扫描二维码加入

很不错，顶一下！

小豆芽疯回路转 · 发表于 2021-10-7 11:12:18

经典案例图书

很不错，顶一下！

wscgb123 · 发表于 2022-5-30 10:38:41

感谢楼主分享，很不错！

wetiuer · 发表于 2022-5-30 11:29:05

看了楼主的宏，获取钣金展开长度和宽度是采用的通过切割清单属性的方式，这也是我目前发现能实现的两种方式之一。1.这种方式能获取正确数值的情况是，软件必须在文档属性中设置“自动更新切割清单”，这样才能保证每次获取的值是模型最新的值。
2.另外就是这种方法有两层循环，先依次循环零件树找到切割清单入口，再在内部再次循环找属性表达式。
3.版本较低的话在自定义属性中是不能链接切割清单的属性，我在SolidWorks2016中没有实现。另外就是建议此方法可以设置为只执行一次，自定义属性已和切割清单关联，之后会自动更新对应值。每次执行太耗时间！
3.遇到多少实体零件，比如一个钣金，一个实体，这样的情况应该获取有困难。
4.我在自己的插件中是使用通过平板型式获取，主要是考虑到不用设置自动更新切割清单，这样减小系统资源开销，让SolidWorks软件运行更快，工作中流畅性好，不受版本限制，任意SolidWorks版本都可以使用，获取效果更快（相对楼主程序中获取切割清单属性表达式，如果可以楼主可以考虑我说的只执行一次，那应该是SolidWorks原生支持的效果更好）

另外就是设置单位，这种一般只需要设置一次，不用每次设置，可以提升效率。

以上是个人看法。

		自动登录	找回密码
密码			立即注册

自己在用的图号分离、删除所有属性、单位，差不多5、6个宏合并到一个宏，求指导优化

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献