使用SOLIDWORKS API进行扩展高级选择的宏
{ width=250 }
该宏使用SOLIDWORKS API来扩展SOLIDWORKS装配中“高级选择”工具中可用的选择条件列表。
该宏允许选择以下组件(或组合):
- Float - 未完全约束的组件(其名称中带有减号(-)的组件)
- ExcludedFromBom - 从BOM中排除的组件(包括包络组件)
- Envelope - 标记为包络的组件
- NoMates - 不包含任何装配关系的组件
要配置该宏,请修改宏的开头处的CRITERIA和TOP_LEVEL_ONLY常量。
Const CRITERIA As Integer = Criteria_e.Float + Criteria_e.NoMates
Const TOP_LEVEL_ONLY As Boolean = False
TOP_LEVEL_ONLY指示是否仅使用顶层组件进行过滤。将此选项设置为True以选择嵌套组件。
Const TOP_LEVEL_ONLY As Boolean = True
CRITERIA是一组过滤器的组合,其中应用Or运算符。
例如:
Const CRITERIA As Integer = Criteria_e.Float + Criteria_e.NoMates '将选择所有浮动组件或没有装配关系的组件
Const CRITERIA As Integer = Criteria_e.Envelope '将选择仅包络组件
根据需要修改宏中的过滤器。
Enum Criteria_e
Float = 1
ExcludedFromBom = 2
Envelope = 4
NoMates = 8
End Enum
Const CRITERIA As Integer = Criteria_e.Float + Criteria_e.NoMates
Const TOP_LEVEL_ONLY As Boolean = False
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swApp.ActiveDoc
If Not swAssy Is Nothing Then
SelectComponents swAssy, CRITERIA, TOP_LEVEL_ONLY
Else
MsgBox "请打开装配体"
End If
Dim val As Criteria_e
val = Envelope + ExcludedFromBom + Float
Debug.Print (val And Envelope) = Envelope
Debug.Print (val And ExcludedFromBom) = ExcludedFromBom
Debug.Print (val And Float) = Float
End Sub
Function SelectComponents(assy As SldWorks.AssemblyDoc, crit As Criteria_e, topLevelOnly As Boolean)
Dim vComps As Variant
vComps = assy.GetComponents(topLevelOnly)
Dim swFilteredComps() As SldWorks.Component2
Dim isArrInit As Boolean
isArrInit = False
Dim i As Integer
For i = 0 To UBound(vComps)
Dim swComp As SldWorks.Component2
Set swComp = vComps(i)
Debug.Print swComp.Name2
Dim isFiltered As Boolean
isFiltered = False
If IsFlagSet(crit, Criteria_e.Float) And swComp.GetConstrainedStatus() <> swConstrainedStatus_e.swFullyConstrained Then
isFiltered = True
ElseIf IsFlagSet(crit, Criteria_e.ExcludedFromBom) And swComp.ExcludeFromBOM Then
isFiltered = True
ElseIf IsFlagSet(crit, Criteria_e.Envelope) And swComp.IsEnvelope() Then
isFiltered = True
ElseIf IsFlagSet(crit, Criteria_e.NoMates) And IsEmpty(swComp.GetMates()) Then
isFiltered = True
End If
If True = isFiltered Then
If False = isArrInit Then
isArrInit = True
ReDim swFilteredComps(0)
Else
ReDim Preserve swFilteredComps(UBound(swFilteredComps) + 1)
End If
Set swFilteredComps(UBound(swFilteredComps)) = swComp
End If
Next
If True = isArrInit Then
Dim swModel As SldWorks.ModelDoc2
Set swModel = assy
If UBound(swFilteredComps) + 1 <> swModel.Extension.MultiSelect2(swFilteredComps, False, Nothing) Then
Err.Raise vbError, , "选择组件失败"
End If
End If
End Function
Function IsFlagSet(val As Criteria_e, flag As Criteria_e) As Boolean
IsFlagSet = (val And flag) = flag
End Function