Skip to main content

SOLIDWORKS VBA macro to copy preselected faces

Author: Eddy Alleman

Offset Surface with distance 0{ width=525 }

This VBA macro creates a new surface feature from selected faces in a part file. Thus duplicating the selected surfaces and giving it a predefined color. This can be usefull if you want to reuse existing surfaces and don't want to consolidate existing ones.

Steps to take

  • A part file must be the active document.
  • You have to select at least one face.
  • If you select other types of entities, they will be filtered out.
  • Run the macro. As the result a Surface Offset is created of the selected faces with distance 0
  • This feature will get a yellow color by default, but you can change the RGB color to set another one.

Author: Eddy Alleman (EDAL Solutions)

Option Explicit

' INPUT You can change to another RGB color here (This example uses yellow)
Const RED = 255
Const GREEN = 255
Const BLUE = 0

Dim swxApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim selMgr As SldWorks.SelectionMgr

Sub main()

try_:
On Error GoTo catch_

Set swxApp = Application.SldWorks

Set swModel = swxApp.ActiveDoc

'Check if active document is a Part file
Select Case True

Case swModel Is Nothing, swModel.GetType <> swDocPART
Call swxApp.SendMsgToUser2("Please open a part file", swMbInformation, swMbOk)

Case Else
Call ProcessSelectedFaces

End Select

GoTo finally_:

catch_:

MsgBox Err.Description

finally_:

End Sub

Private Function ProcessSelectedFaces() As Boolean

EnableUpdates False

Set selMgr = swModel.SelectionManager

'Get number of selections
Dim nSelections As Integer
nSelections = selMgr.GetSelectedObjectCount2(-1)

'only process if there is something selected
If nSelections > 0 Then

Call RemoveNonFacesFromSelection

'Get the number of selected faces
Dim nFaces As Integer
nFaces = selMgr.GetSelectedObjectCount2(-1)

If nFaces > 0 Then

'Offset selected faces
swModel.InsertOffsetSurface 0#, False

'Give a name to the newly created offset feature
Dim featOffset As Feature
Set featOffset = swModel.Extension.GetLastFeatureAdded

featOffset.Name = featOffset.Name & " Offsets " & nFaces & " Faces"

'give the offset feature a color
Call SetColor(featOffset)

' Deselect face to see new color
swModel.ClearSelection2 True

End If 'nFaces > 0

End If 'nSelections > 0

EnableUpdates True

End Function


Private Function EnableUpdates(update As Boolean)
With swModel
.FeatureManager.EnableFeatureTree = update
.ActiveView.EnableGraphicsUpdate = update
End With
End Function

'Removes entities that are not faces from the selection manager
Private Function RemoveNonFacesFromSelection()

'Get number of selections
Dim nSelections As Integer
nSelections = selMgr.GetSelectedObjectCount2(-1)

Dim i As Integer
For i = 0 To nSelections

Dim ObjectType As Long
ObjectType = selMgr.GetSelectedObjectType3(i, -1)

If ObjectType <> swSelectType_e.swSelFACES Then
Dim res As Boolean
res = selMgr.DeSelect2(i, -1)
End If

Next

End Function

'Sets the INPUT color on a feature
Private Function SetColor(ByRef Feat As Feature) As Boolean

'get material properties from model
Dim MatProp As Variant
MatProp = swModel.MaterialPropertyValues

' set color fi. RGB(225, 255 , 0), but we need them to be in range 0 to 1
MatProp(0) = RED / 255
MatProp(1) = GREEN / 255
MatProp(2) = BLUE / 255

SetColor = Feat.SetMaterialPropertyValues(MatProp)

End Function