macro help needed

[BarryH]

Hi all, I am new to this forum and have no programming experience. I have recorded a macro which takes a preselected flat face and offsets the perimeter by a set distance inwards. (I use it frequently for locating screw holes). It works perfectly every time. I then select that sketch, right click and change the colour to red. It would be great if I could integrate the colour change into the macro. I have tried recording it but the colour does not change. Can anybody help?

[Jordan Brown]

I cannot find an accessor for the sketch colour in the sketch interface. Unless it is hidden somewhere obscure, I do not think that it can be changed using the API.

Storm

[SPerman]

This may help:

https://r1132100503382-eu1-3dswym.3dexp ... TK7RRdwYEQ

[JSculley]

Code: Select all

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim mDoc As ModelDoc2
Dim selMgr As SelectionMgr
Dim sketchMgr As SketchManager
Dim theSketch As Sketch
Dim theSketchFeature As Feature
Dim selCount As Long
Dim selType As swSelectType_e
Dim selFace As Face2
Dim i As Integer
Dim result As Boolean
Sub main()
    Set swApp = Application.SldWorks
    Set mDoc = swApp.ActiveDoc
    Set selMgr = mDoc.SelectionManager
    selCount = selMgr.GetSelectedObjectCount2(-1)
    If selCount <> 1 Then 'Too many things selected, notify user and exit
        swApp.SendMsgToUser2 "Please select a single planar face", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        Exit Sub
    End If
    selType = selMgr.GetSelectedObjectType3(1, -1)
    If Not selType = swSelFACES Then 'Selection is not a face, notify user and exit
        swApp.SendMsgToUser2 "Please select a single planar face", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        Exit Sub
    End If
    Set selFace = selMgr.GetSelectedObject6(1, -1)
    Dim norm As Variant
    norm = selFace.Normal
    If norm(0) = 0 And norm(2) = 0 And norm(1) = 0 Then 'Face is not planar, notify user and exit
        swApp.SendMsgToUser2 "Selected face is not planar", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        Exit Sub
    End If
    Set sketchMgr = mDoc.SketchManager
    sketchMgr.InsertSketch False 'Start sketch on face
    Set theSketch = sketchMgr.activeSketch
    result = mDoc.SketchOffsetEntities2(-0.25 * 25.4 / 1000, False, False)  'Offset face 0.25" inward
    sketchMgr.InsertSketch True 'Exit sketch
    Set theSketchFeature = selMgr.GetSelectedObject6(1, -1) 'Get feature for the sketch which is selected
    Dim props As Variant
    props = theSketchFeature.GetMaterialPropertyValues2(1, Nothing) 'Get the current properties
    props(0) = 1 'Set the RED value
    props(1) = 0 'Set the GREEN value
    props(2) = 0 'Set the BLUE value
    theSketchFeature.SetMaterialPropertyValues2 props, 1, Nothing 'Set the properties
End Sub

[BarryH]

Thank you very much JSculley, That works perfectly!