标题: 装配体材料栏设置自定义属性为“组件”报错 [打印本页] 作者: nishuihanjian 时间: 2024-4-22 08:02 标题: 装配体材料栏设置自定义属性为“组件”报错 装配体材料栏设置自定义属性为“组件”报错：点选装配体下面的自装配体或者选装配体自身时报错，点选装配体下的零件或者选择零件自身正常，报错语句为 Set swPart = swComp.GetModelDoc2，这个设定零件类型不正确吗，求大神修改成点选装配体另行也能设置。
Sub SetMaterial(materialName As String, customPropertyValue As String, _
Optional red As Variant, Optional green As Variant, Optional blue As Variant, _
Optional surfaceTreatment As String = "无")
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.partDoc
Dim swAssembly As SldWorks.AssemblyDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim configName As String
Dim databaseName As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType = swDocumentTypes_e.swDocPART Then ' 零件
Set swPart = swModel
ApplyMaterial swPart, materialName, customPropertyValue, surfaceTreatment
If Not IsMissing(red) And Not IsMissing(green) And Not IsMissing(blue) Then
ChangePartColor swModel, red / 255, green / 255, blue / 255
End If
MsgBox "已为零件设置材质为" & materialName & "并设置自定义属性。"
ElseIf swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then ' 装配体
Set swAssembly = swModel
Set swSelMgr = swModel.SelectionManager
Dim n As Integer
n = swSelMgr.GetSelectedObjectCount2(-1)
If n = 0 Then
MsgBox "请选中零件后运行。", vbExclamation, "错误"
Exit Sub
End If
Dim i As Integer
For i = 1 To n
Dim swComp As SldWorks.Component2
Set swComp = swSelMgr.GetSelectedObjectsComponent4(i, -1)
Set swPart = swComp.GetModelDoc2
If Not swComp Is Nothing Then
ApplyMaterial swPart, materialName, customPropertyValue, surfaceTreatment
If Not IsMissing(red) And Not IsMissing(green) And Not IsMissing(blue) Then
ChangePartColor swPart, red / 255, green / 255, blue / 255
End If
End If
Next i