AnsweredAssumed Answered

holewizard coloring

Question asked by Isak Karlsson on Apr 23, 2020
Latest reply on Apr 23, 2020 by Matthew Cempa

i have a macro i use to color all the hole wizard features in a part. i wounder if there is a easy way to modify it so it only apply colors to hole wizard taped holes?


Option Explicit

Const APPEARANCE_PATH As String = _
"C:\Users\Administratör\Desktop\FärgTolerans\Färger\hål (grå).p2m"

Sub HoleWizard()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swObj As Object
Dim swRenderMat As SldWorks.RenderMaterial

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager

Dim nSel As Integer
nSel = swSelMgr.GetSelectedObjectCount2(-1)

Dim i As Integer
For i = 1 To nSel
Dim swFeature As SldWorks.Feature
If swSelMgr.GetSelectedObjectType3(i, -1) = 22 Then
Set swFeature = swSelMgr.GetSelectedObject6(i, -1)
If swFeature.GetTypeName2 = "HoleWzd" Then

Set swObj = swSelMgr.GetSelectedObject6(i, -1)

If swModel.GetType = swDocPART Then

If swObj Is Nothing Then Set swObj = swModel

ElseIf swModel.GetType = swDocASSEMBLY Then

Dim swAssy As SldWorks.AssemblyDoc
Dim swComp As SldWorks.Component2
Dim lngInfo As Long

Set swAssy = swModel

If TypeOf swObj Is SldWorks.Face2 Or _
TypeOf swObj Is SldWorks.Feature Or _
TypeOf swObj Is SldWorks.Body2 Then

Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
swComp.Select4 False, Nothing, False
swAssy.EditPart2 False, True, lngInfo

If lngInfo = -1 Then
swApp.SendMsgToUser "Failed to edit component."
Exit Sub
End If

End If

Exit Sub
End If

Set swRenderMat = swModel.Extension.CreateRenderMaterial(APPEARANCE_PATH)

If swRenderMat.AddEntity(swObj) = False Then
swApp.SendMsgToUser "Failed to add entity."
Exit Sub
End If

If swModel.Extension.AddDisplayStateSpecificRenderMaterial( _
swRenderMat, swAllDisplayState, Empty, Empty, Empty) = False Then
swApp.SendMsgToUser "Failed to add appearance."
Exit Sub
End If
End If
End If

Next i


If Not swComp Is Nothing Then
swComp.Select4 False, Nothing, False
End If
Call main3

End Sub