Morning all,
I found a pretty simple macro online that applies an appearance to parts, in my case, Pine. Currently, I go in and change the orientation of the grain to go along the longest dimension (think a 2x4x8', grain along the length, as it would appear in reality). I'm wondering if there is a way to include this function in the macro? Check for the longest dimension, and orient the appearance to match? Any help is greatly appreciated, the macro is below.
Option Explicit
Const APPEARANCE_PATH As String = _
"C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\data\graphics\Materials\organic\wood\pine\satin finished pine 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