批量開零件及裝配件取自訂屬性複製到配置特定（批量开零件及装配件取自定义属性复）

ryouss · 发表于 2018-6-20 11:34:04

參考
SWP文件

批量自訂屬性複製到配置屬性.rar (11.01 KB, 下载次数: 341)
應用例如: https://www.swbbsc.com/forum.php? ... 3561&extra=page%3D1

'
' 在某文件路徑下批量開零件及裝配件取自訂屬性複製到[url=https://www.swbbsc.com/forum-53-1.html]配置[/url]特定
' sc liang 2018/6/20
' 測試版 2012 sp4
'
'~~~ Main ~~~
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc
Dim Part As Object
Dim sFileName As String
Dim path As String
Dim Tpye_ As String
Dim nErrors As Long
Dim nWarnings As Long
'~~~ CopyToConfiguration ~~
'Dim swModel As SldWorks.ModelDoc2
Dim swCustPrpMgr As SldWorks.CustomPropertyManager
Dim swConfCustPrpMgr As SldWorks.CustomPropertyManager
Sub Main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
path = InputBox("Enter a folder path containing any Solidworks files (For example '' C:\test\ '' )", "Parts path location", "C:\test\") '鍵入存檔路徑
sFileName = Dir(path & "*.sld*") '取出SW檔
'循環開檔
Do Until sFileName = ""
Type_ = Right(sFileName, 3) '取得SW文件擴展名後三位
Select Case Type_
'開零件檔
Case "PRT"
Set swModel = swApp.OpenDoc6(path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings) '開零件檔
CopyToConfiguration
'開組件檔
Case "ASM"
Set swModel = swApp.OpenDoc6(path + sFileName, swDocASSEMBLY, swOpenDocOptions_Silent, "", nErrors, nWarnings) '開組件檔
CopyToConfiguration
End Select
'Set Part = swApp.ActiveDoc
If Type_ <> "DRW" Then
swModel.Save '存檔
swApp.CloseDoc swModel.GetTitle '關檔
End If
Set swModel = Nothing
sFileName = Dir '同路徑取出下個SW文件檔名
Loop
End Sub
'~~~ 零件及組件之自訂屬性複製到[url=https://www.swbbsc.com/forum-53-1.html]配置[/url]特定
Sub CopyToConfiguration()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
Dim vNames As Variant
Dim vTypes As Variant
Dim vValues As Variant
swCustPrpMgr.GetAll vNames, vTypes, vValues
Dim activeConfName As String
activeConfName = swModel.ConfigurationManager.ActiveConfiguration.Name
Set swConfCustPrpMgr = swModel.Extension.CustomPropertyManager(activeConfName)
Dim i As Integer
For i = 0 To UBound(vNames)
swConfCustPrpMgr.Add2 vNames(i), vTypes(i), vValues(i)
'swConfCustPrpMgr.Set vNames(i), vValues(i)
Next
Else
MsgBox "Please open part or assembly"
End If
End Sub

复制代码

hdgd501 · 发表于 2018-6-20 19:19:34

谢谢楼主无私奉献精神，

qxzch · 发表于 2018-6-21 22:56:27

很实用的宏，给楼主点赞！

r68ser52 · 发表于 2018-6-22 23:42:09

提示出错了

，我自己再仔细看看

sjj1234 · 发表于 2018-6-23 09:53:04

经典案例图书

楼主辛苦了！

河西 · 发表于 2018-7-20 17:16:42

谢谢无私分享！

阡上紫陌 · 发表于 2018-8-3 11:00:53

经典案例图书

看看，学习学习

jianli · 发表于 2018-11-28 11:39:15

学习中，谢谢分享。

ningxin4567 · 发表于 2018-12-5 13:32:22

宏还是比较给力的。。。。。。。

wwwerzhou · 发表于 2019-1-4 13:08:54

这个非常不错！！！

bright160 · 发表于 2019-6-13 11:01:34

很实用的东东，

bright160 · 发表于 2019-6-13 11:07:28

太棒了，很实用的，有需要的可以下载用用

外地患者~ · 发表于 2019-6-27 14:40:26

感谢楼主分享，很不错！

明泉2016 · 发表于 2019-7-6 14:21:06

楼主辛苦了！

jyzas001 · 发表于 2019-7-14 13:05:51

加入QQ群
参与讨论和学习

或扫描二维码加入

谢谢分享

grlhnl · 发表于 2019-10-7 17:20:50

经典案例图书

出现错误，怎么回事？用的是2016

tengda1234 · 发表于 2019-12-3 15:14:24

加入QQ群
参与讨论和学习

或扫描二维码加入

不好用啊，2018表示用不了

chai815 · 发表于 2020-6-14 21:11:57

经典案例图书

感谢分享学习了

jst2823 · 发表于 2021-1-19 22:34:33

SolidWorks机械工程师网，顶一下。

wwwerzhou · 发表于 2021-1-21 16:44:47

很不错，找到组织了！

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

批量開零件及裝配件取自訂屬性複製到配置特定（批量开零件及装配件取自定义属性复）

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献