|
- '在装配体中选择首选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
复制代码
|
|