求助，复制属性A零件到BCD零件

xieguiming1982 · 发表于 2024-2-22 11:19:23

'在装配体中选择首选A零件，然后选择后续的B、C、D多个零件，可以一键复制A零件的自定义属性和配置属性到后选的零件。
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim sourceComponent As SldWorks.Component2
Dim destComponents As Collection
Sub Main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Dim selMgr As SldWorks.SelectionMgr
Set selMgr = swModel.SelectionManager
' 检查当前选中的零件是否为装配体
If swModel.GetType = 2 Then
' 获取首选A零件作为源零件
Set sourceComponent = selMgr.GetSelectedObjectsComponent4(1, -1)
' 创建一个集合来存储后续选中的目标零件
Set destComponents = New Collection
Dim i As Integer
For i = 2 To selMgr.GetSelectedObjectCount2(-1)
destComponents.Add selMgr.GetSelectedObjectsComponent4(i, -1)
Next i
' 复制自定义属性和配置属性到后选的零件
' CopyPropertiesToDest(sourceComponent, destComponents)
Else
MsgBox "请在装配体中选择首选A零件！"
End If
End Sub
Sub CopyPropertiesToDest(sourceComp As SldWorks.Component2, destComps As Collection)
Dim sourceModel As SldWorks.ModelDoc2
Set sourceModel = sourceComp.GetModelDoc2()
' 获取源零件的自定义属性和配置属性
Dim sourceCustPrpMgr As SldWorks.CustomPropertyManager
Dim sourceConfCustPrpMgr As SldWorks.CustomPropertyManager
Set sourceCustPrpMgr = sourceModel.Extension.CustomPropertyManager("")
Set sourceConfCustPrpMgr = sourceModel.Extension.CustomPropertyManager(sourceModel.ConfigurationManager.ActiveConfiguration.Name)
Dim destComp As SldWorks.Component2
Dim destModel As SldWorks.ModelDoc2
Dim propNames As Variant
Dim propTypes As Variant
Dim propValues As Variant
Dim i As Integer
For Each destComp In destComps
Set destModel = destComp.GetModelDoc2()
' 复制自定义属性到目标零件
sourceCustPrpMgr.GetAll propNames, propTypes, propValues
Dim destCustPrpMgr As SldWorks.CustomPropertyManager
Set destCustPrpMgr = destModel.Extension.CustomPropertyManager("")
For i = 0 To UBound(propNames)
destCustPrpMgr.Add2 propNames(i), propTypes(i), propValues(i)
destCustPrpMgr.Set propNames(i), propValues(i)
Next i
' 复制配置属性到目标零件
sourceConfCustPrpMgr.GetAll propNames, propTypes, propValues
Dim destConfCustPrpMgr As SldWorks.CustomPropertyManager
Set destConfCustPrpMgr = destModel.Extension.CustomPropertyManager(destModel.ConfigurationManager.ActiveConfiguration.Name)
For i = 0 To UBound(propNames)
destConfCustPrpMgr.Add2 propNames(i), propTypes(i), propValues(i)
destConfCustPrpMgr.Set propNames(i), propValues(i)
Next i
Next destComp
End Sub