Jetzt habe ich das gefunden:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelData As SldWorks.SelectData
Dim swFeat As SldWorks.Feature
Dim swFaceFeat As SldWorks.Feature
Dim vFaceArr As Variant
Dim vFace As Variant
Dim vFeatColor As Variant
Dim swFace As SldWorks.Face2
Dim swEnt As SldWorks.Entity
Dim i As Long
Dim bRet As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject5(1)
Set swSelData = swSelMgr.CreateSelectData
Debug.Print "Feature = " + swFeat.name + " [" + swFeat.GetTypeName + "]"
Debug.Print " Face count = " & swFeat.GetFaceCount
swModel.ClearSelection2 True
vFeatColor = swModel.MaterialPropertyValues
vFeatColor(0) = myR 'R
vFeatColor(1) = myG 'G
vFeatColor(2) = myB 'B
vFaceArr = swFeat.GetFaces: If IsEmpty(vFaceArr) Then Exit Sub
For Each vFace In vFaceArr
Set swFace = vFace
Set swEnt = swFace
Set swFaceFeat = swFace.GetFeature
' Check to see if face is owned by multiple features
If swFaceFeat Is swFeat Then
bRet = swEnt.Select4(True, swSelData): Debug.Assert bRet
swFace.MaterialPropertyValues = vFeatColor
Else
Debug.Print " Other feature = " & swFaceFeat.name + " [" + swFaceFeat.GetTypeName + "]"
End If
Next
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP