macro help needed

Library for macros
BarryH
Posts: 4
Joined: Tue Nov 08, 2022 8:38 am
Answers: 1
x 1

macro help needed

Unread post by 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?
by JSculley » Wed Nov 09, 2022 1:49 pm

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

Go to full post
Jordan Brown
Posts: 26
Joined: Wed Jul 21, 2021 3:20 pm
Answers: 0
x 6
x 2

Re: macro help needed

Unread post by 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
User avatar
SPerman
Posts: 2035
Joined: Wed Mar 17, 2021 4:24 pm
Answers: 14
x 2207
x 1860
Contact:

Re: macro help needed

Unread post by SPerman »

-
I may not have gone where I intended to go, but I think I have ended up where I needed to be. -Douglas Adams
User avatar
JSculley
Posts: 638
Joined: Tue May 04, 2021 7:28 am
Answers: 55
x 9
x 868

Re: macro help needed

Unread post by 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
Posts: 4
Joined: Tue Nov 08, 2022 8:38 am
Answers: 1
x 1

Re: macro help needed

Unread post by BarryH »

Thank you very much JSculley, That works perfectly!
Post Reply