|
经典图书 ExtrudeFeatureData.SetDepth →模拟特征编辑的应用
程序如下
Sub lss()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim count As Long
Dim swComponent As SldWorks.Component2
Dim Feature As Object
Dim retval As Boolean
Dim ExtrudeFeatureData As Object
Dim Depth As Double
Dim Factor As Double
Factor = 0.5 'CInt(txtDepth.Text)
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
count = swSelMgr.GetSelectedObjectCount
If count > 1 Then
swApp.SendMsgToUser2 "请选择特征名称为 拉伸1 的特征!", swMbWarning, swMbOk
Exit Sub
End If
Set Feature = swSelMgr.GetSelectedObject3(count)
If Not Feature.GetTypeName = swTnExtrusion Then
swApp.SendMsgToUser2 "请选择特征名称为 拉伸1 的特征!", swMbWarning, swMbOk
'Exit Sub
End If
Set ExtrudeFeatureData = Feature.GetDefinition
retval = ExtrudeFeatureData.AccessSelections(swModel, swComponent)
Depth = ExtrudeFeatureData.GetDepth(True)
ExtrudeFeatureData.SetDepth True, 0.1 'Depth * Factor
retval = Feature.ModifyDefinition(ExtrudeFeatureData, swModel, swComponent)
If Not retval Then
swApp.SendMsgToUser2 "不能修改特征数据!", swMbWarning, swMbOk
ExtrudeFeatureData.ReleaseSelectionAccess
End If
End Sub |
|