Right now i am using a macro code to add apperances to the marked features but i can only do one at a time. how do i edit this code so i can mark multiple features? or even so i can just run this macro and it it automaticly apply this to all hole wizard features it can find?
- 'Written by Keith Rice
- 'CADSharp LLC
- 'www.cadsharp.com
- Option Explicit
- Const APPEARANCE_PATH As String = _
- "c:\Program Files\solidworks corp\solidworks\data\graphics\materials\organic\wood\maple\polished maple 2d.p2m"
- Sub main()
- 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
- Set swObj = swSelMgr.GetSelectedObject6(1, -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
- Else
- 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
- swModel.EditRebuild3
- If Not swComp Is Nothing Then
- swComp.Select4 False, Nothing, False
- swAssy.EditAssembly
- End If
- End Sub