Changes the color of a part using vba macro in solidworks api

Viewed 40

I'm trying to change the appearance of a part using the VBA code.

I found a code already on the forum that changes the color for each face individually, but that's a complicated code to use for a simple part.

I tried to record a macro while changing the color but nothing was captured in the macro for some reason.

I tried also to look into the help documentation and all I found was this one: https://help.solidworks.com/2017/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.iappearancesetting~color.html

And that's my code along with color commands.

Dim swModel As ModelDoc2
Dim boolstatus As Boolean
Dim swApp As SldWorks
Private x, X1, Y1, X2, Y2 As Integer
swModel = swApp.NewPart()
swModel = swApp.ActiveDoc
    
'Drawing 2D Sketch
boolstatus = swModel.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Dim swSketch As SketchManager
swSketch = swModel.SketchManager
swSketch.InsertSketch(True)
X1 = 2
Y1 = 2
X2 = 2
Y2 = 2
Dim skSegment As Object
skSegment = swModel.SketchManager.CreateLine(0, 0, 0#, 2, 0, 0#)
skSegment = swModel.SketchManager.CreateLine(2, 0, 0#, 2, 2, 0#)
skSegment = swModel.SketchManager.CreateLine(2, 2, 0#, 0, 2, 0#)
skSegment = swModel.SketchManager.CreateLine(0, 2, 0#, 0, 0, 0#)
swModel.SketchManager.InsertSketch(True)
swModel.ClearSelection2(True)
swModel.ViewZoomtofit()

' Extrude
Dim CreateExtrude As Feature
boolstatus = swModel.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
CreateExtrude = swModel.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 3, 0.01, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)

'''''''''''' COLOR Changing based on the link above '''''''''''''''
Dim Part_color As IAppearanceSetting
Dim value As Integer = 0
value = Math.Max(Math.Min(120, 255), 0) + Math.Max(Math.Min(120, 255), 0) * 16 * 16 + Math.Max(Math.Min(120, 255), 0) * 16 * 16 * 16 * 16
Part_color.Color = value

''''''''''''''

The part was created successfully but the color changing didn't work.

Any thoughts?

1 Answers

I got the answer from the SolidWorks forum (Thanks to Mr. Willie Roelofs)

I just kept the post in case someone is a super beginner in API like me and looking for the same thing.

If it's not useful, just delete it :)

Option Explicit

Sub main()

   Dim boolStatus As Boolean
   Dim swApp As SldWorks.SldWorks
   Set swApp = Application.SldWorks
   Dim swModel As SldWorks.ModelDoc2
   Set swModel = swApp.ActiveDoc
   
   Call Draw2DSketch(swModel)
   Call ExtrudeSketch(swModel)
   Call ColorPart(swModel)

End Sub
Function Draw2DSketch(swModel As SldWorks.ModelDoc2)

   'Drawing 2D Sketch
   Dim boolStatus As Boolean
   boolStatus = swModel.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
   Dim swSketch As SketchManager
   Set swSketch = swModel.SketchManager
   swSketch.InsertSketch True
   swModel.ClearSelection2 True
   Dim skSegment As Object
   Set skSegment = swModel.SketchManager.CreateLine(0, 0, 0#, 2, 0, 0#)
   Set skSegment = swModel.SketchManager.CreateLine(2, 0, 0#, 2, 2, 0#)
   Set skSegment = swModel.SketchManager.CreateLine(2, 2, 0#, 0, 2, 0#)
   Set skSegment = swModel.SketchManager.CreateLine(0, 2, 0#, 0, 0, 0#)
   swModel.SketchManager.InsertSketch (True)
   swModel.ClearSelection2 (True)
   swModel.ViewZoomtofit

End Function
Function ExtrudeSketch(swModel As SldWorks.ModelDoc2)

   Dim boolStatus As Boolean
   boolStatus = swModel.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
   Dim CreateExtrude As Feature
   On Error Resume Next
   CreateExtrude = swModel.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 3, 0.01, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
   On Error GoTo 0
   
End Function
Function ColorPart(swModel As SldWorks.ModelDoc2)

   Dim vMatProps
   vMatProps = swModel.MaterialPropertyValues
   'Define the RGB values (1 = RGB value 255)
   vMatProps(0) = 154 / 255 'R
   vMatProps(1) = 155 / 255 'G
   vMatProps(2) = 156 / 255 'B
   
   swModel.MaterialPropertyValues = vMatProps
   swModel.GraphicsRedraw2
    
End Function
Related