Solidworks二次开发_遍历特征树基准面基准面名称

Sub main()
GET_Feature
End Sub


Private Function GET_Feature()

'本程序通过遍历特征树，打印所有特征树中名称是的基准面和基准轴的名称
'本程序2013.11.12调试通过，作者：张中锋，邮箱：xzzfx@https://www.wendangku.net/doc/b814663516.html,
'
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature

Dim swAssy As SldWorks.AssemblyDoc
Dim swConf As SldWorks.Configuration
Dim swRootComp As https://www.wendangku.net/doc/b814663516.html,ponent2

Dim nStart As Single
Dim bRet As Boolean


Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then '检查模型

Set swConf = swModel.GetActiveConfiguration
Debug.Print "File = " & swModel.GetPathName

If Right(swModel.GetPathName, 1) = "M" Or Right(swModel.GetPathName, 1) = "m" Then '装配体

Set swFeat = swModel.FirstFeature

TraverseFeatureFeatures swFeat, 1 '获取装配体级的特征名称

Set swRootComp = swConf.GetRootComponent3(True)

TraverseComponent swRootComp, 1 '遍历子件

ElseIf Right(swModel.GetPathName, 1) = "t" Or Right(swModel.GetPathName, 1) = "T" Then '零件
Set swFeat = swModel.FirstFeature

TraverseFeatureFeatures swFeat, 1 '获取装配体级的特征名称
Else
MsgBox "当前的模型不是零件或者装配体"

End If
Else
MsgBox "错误的模型对象"
End If
End Function
Private Function TraverseFeatureFeatures(swFeat As SldWorks.Feature, nLevel As Long)

Dim swSubFeat As SldWorks.Feature

Dim swSubSubFeat As SldWorks.Feature

Dim swSubSubSubFeat As SldWorks.Feature

Dim sPadStr As String

Dim i As Long


For i = 0 To nLevel

sPadStr = sPadStr + " "

Next i

While Not swFeat Is Nothing

If swFeat.GetTypeName = "RefPlane" Or swFeat.GetTypeName = "RefAxis" Then '判断特征的是否是基准面或者基准轴

'如果要获取任何类型的特征，在上面的IF里面修改条件

Debug.Print sPadStr + https://www.wendangku.net/doc/b814663516.html, + " [" + swFeat.GetTypeName + "]"
Else

End If

Set swFeat = swFeat.GetNextFeature

Wend

End Function

Private Function TraverseComponent(swComp As https://www.wendangku.net/doc/b814663516.html,ponent2, nLevel As Long) '遍历装配体里面的所有子件

Dim vChildComp As Variant

Dim swChildComp As https://www.wendangku.net/doc/b814663516.html,ponent2

Dim swCompConfig As SldWorks.Configuration

Dim sPadStr

As String
Dim swFeat As SldWorks.Feature
Dim i As Long


For i = 0 To nLevel - 1

sPadStr = sPadStr + " "

Next i

vChildComp = swComp.GetChildren

For i = 0 To UBound(vChildComp) '当是装配体时，遍历下级子件

Set swChildComp = vChildComp(i)

Debug.Print sPadStr & "+" & https://www.wendangku.net/doc/b814663516.html,2 & " <" & swChildComp.ReferencedConfiguration & ">"

Set swFeat = swChildComp.FirstFeature
TraverseFeatureFeatures swFeat, nLevel '遍历当前子件的特征
If Right(swChildComp.GetPathName, 1) = "M" Or Right(swChildComp.GetPathName, 1) = "m" Then '子件是装配体时
TraverseComponent swChildComp, nLevel + 1 '继续遍历
End If
Next i

End Function