AnsweredAssumed Answered

help with macro code

Question asked by Isak Karlsson on Oct 28, 2019
Latest reply on Nov 6, 2019 by Madson Germano

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  

Outcomes