This website uses cookies to ensure you get the best experience on our website. By using our website you agree on the following Cookie Policy, Privacy Policy, and Terms Of Use
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.
OptionExplicit' 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_:
OnErrorGoTo catch_
Set swxApp = Application.SldWorks
Set swModel = swxApp.ActiveDoc
'Check if active document is a Part fileSelectCaseTrueCase swModel IsNothing, swModel.GetType <> swDocPART
Call swxApp.SendMsgToUser2("Please open a part file", swMbInformation, swMbOk)
CaseElseCall ProcessSelectedFaces
EndSelectGoTo finally_:
catch_:
MsgBox Err.Description
finally_:
EndSubPrivateFunction ProcessSelectedFaces() AsBoolean
EnableUpdates FalseSet selMgr = swModel.SelectionManager
'Get number of selectionsDim nSelections AsInteger
nSelections = selMgr.GetSelectedObjectCount2(-1)
'only process if there is something selectedIf nSelections > 0 ThenCall RemoveNonFacesFromSelection
'Get the number of selected facesDim nFaces AsInteger
nFaces = selMgr.GetSelectedObjectCount2(-1)
If nFaces > 0 Then'Offset selected faces
swModel.InsertOffsetSurface 0#, False'Give a name to the newly created offset featureDim featOffset As Feature
Set featOffset = swModel.Extension.GetLastFeatureAdded
featOffset.Name = featOffset.Name & " Offsets " & nFaces & " Faces"'give the offset feature a colorCall SetColor(featOffset)
' Deselect face to see new color
swModel.ClearSelection2 TrueEndIf'nFaces > 0EndIf'nSelections > 0
EnableUpdates TrueEndFunctionPrivateFunction EnableUpdates(update AsBoolean)
With swModel
.FeatureManager.EnableFeatureTree = update
.ActiveView.EnableGraphicsUpdate = update
EndWithEndFunction'Removes entities that are not faces from the selection managerPrivateFunction RemoveNonFacesFromSelection()
'Get number of selectionsDim nSelections AsInteger
nSelections = selMgr.GetSelectedObjectCount2(-1)
Dim i AsIntegerFor i = 0 To nSelections
Dim ObjectType AsLong
ObjectType = selMgr.GetSelectedObjectType3(i, -1)
If ObjectType <> swSelectType_e.swSelFACES ThenDim res AsBoolean
res = selMgr.DeSelect2(i, -1)
EndIfNextEndFunction'Sets the INPUT color on a featurePrivateFunction SetColor(ByRef Feat As Feature) AsBoolean'get material properties from modelDim MatProp AsVariant
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)
EndFunction