ExtrudeFeatureData.SetDepth应用

朱伟 · 发表于 2011-8-9 16:00:20

经典图书

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

werrrb · 发表于 2011-8-9 16:15:19

加上 Part.Parameter("TubeD@固定管板1").的应用.
----------
Sub lss()
Dim swApp As SldWorks.SldWorks
Dim Part 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 = GetObject(, "sldworks.application")
Set Part = swApp.ActiveDoc
  Part.Parameter("TubeD@固定管板1").SystemValue = 1.8
  Part.Parameter("fd@管板凸台").SystemValue = 1.7
Set swSelMgr = Part.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(Part, swComponent)
Depth = ExtrudeFeatureData.GetDepth(True)
ExtrudeFeatureData.SetDepth True, 0.2 'Depth * Factor
retval = Feature.ModifyDefinition(ExtrudeFeatureData, Part, swComponent)
If Not retval Then
      swApp.SendMsgToUser2 "不能修改特征数据！", swMbWarning, swMbOk
      ExtrudeFeatureData.ReleaseSelectionAccess
End If
End Sub

		自动登录	找回密码
密码			立即注册

ExtrudeFeatureData.SetDepth应用

相关帖子