宏--拉伸切除特征定义修改为给定深度

pyczt · 发表于 2018-4-27 11:22:49

' ******************************************************************************
'镜向阵列时,由于拉伸切除特征中定义是拉伸到某点或到某线或到某面,出现报错。通过宏将定义改为给定深度，避免报错 04/25/2018 by PYCZT
'预选:选择一个拉伸或切除特征
'结果:根据特征的定义进行计算出给定深度,并修改定义
' ******************************************************************************
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim SwSketch As SldWorks.Sketch
Dim swExtrusionData As ExtrudeFeatureData2 '定义拉伸切除特征参数
Dim boolstatus As Boolean
Dim Forward As Boolean
Dim EndCondvalue(1) As Integer
Dim SwEndConRef As Object
Dim FromEntity As Object
Dim FromEntityType As Long
Dim Sketchplane As SldWorks.Entity
Dim nEntType As Long
Dim vPoint1, vPoint2, vPoint3, vPoint4 As Variant
Dim EndCondition1, EndCondition2 As Long
Dim Depth As Double
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject5(1)
Debug.Print swFeat.Name & " [" & swFeat.GetTypeName & "]" '特征名
Set SwSketch = swFeat.GetFirstSubFeature.GetSpecificFeature2 'GetChildren
Debug.Print "Sketch Name = 草图名称为 " + SwSketch.Name
Set swExtrusionData = swFeat.GetDefinition '取得特征参数
boolstatus = swExtrusionData.AccessSelections(swModel, Nothing) '获取访问特征参数,此条必须!
Dim Ref1 As Object
Dim Type1 As Long
Dim Ref2 As Object
Dim Type2 As Long
Dim DirectNumValue As Long
DirectNumValue = swExtrusionData.GetDirectionReference(Ref1, Type1, Ref2, Type2)
Debug.Print " DirectNumValue = " & DirectNumValue
If DirectNumValue >= 1 Then
MsgBox "暂不支持存在方向参考,执行退出"
Exit Sub
End If
Forward = True '方向初值
For I = 0 To 1
EndCondvalue(I) = swExtrusionData.GetEndCondition(Forward)
Debug.Print "第" & I & " 终止条件为EndConditionvalue " & EndCondvalue(I)
Select Case EndCondvalue(I)
Case 0
Debug.Print "swEndCondBlind 给定深度"
Case 1
Debug.Print "swEndCondThroughAll完全贯穿"
Case 2
Debug.Print "swEndCondThroughNext成形到下个面"
Case 3
Debug.Print "swEndCondUpToVertex成形到顶点 "
Case 4
Debug.Print "swEndCondUpToSurface成形到一面 "
Case 5
Debug.Print "swEndCondOffsetFromSurface成形到离指定面指定的距离"
Case 6
Debug.Print "'swEndCondMidPlane两侧对称"
Case 7
Debug.Print "'swEndCondUpToBody成形到实体"
End Select
If EndCondvalue(I) = 0 Or EndCondvalue(I) = 1 Or EndCondvalue(I) = 2 Or EndCondvalue(I) = 5 Or EndCondvalue(I) = 6 Or EndCondvalue(I) = 7 Then
Debug.Print "终止条件已是拉伸或切除深度或其它不合适项,无需转换"
GoTo nextdo
End If
Dim ReferenceType As Long
Set SwEndConRef = swExtrusionData.GetEndConditionReference(Forward, ReferenceType) '获得终止对象
' Dim EndConRefValue As String
' EndConRefValue = swModel.GetEntityName(SwEndConRef)
' Debug.Print " SwEndConRefName = " & EndConRefValue
swExtrusionData.GetFromEntity FromEntity, FromEntityType '获得开始对象,只有在曲面/面/基准面有效,否则为nothing值
Debug.Print " FromEntityType拉伸或切除是从哪里开始的实体的几何类型 = " & FromEntityType
'注意上面几何类型值FromEntityType与下面的类型值swExtrusionData.FromType不一致
'以下四种从哪里开始情况分别计算实际深度
Select Case swExtrusionData.FromType
Case SwConst.swExtrudeFrom_e.swExtrudeFrom_SketchPlane
Debug.Print " from: sketchplane 从草图基准面"
Set Sketchplane = SwSketch.GetReferenceEntity(nEntType) '因为原来FromEntity为空值,所以通过草图得到基准面或平面或曲面
Depth = swModel.ClosestDistance(SwEndConRef, Sketchplane, vPoint1, vPoint2) '计算终止对象与草图平面的距离
Case SwConst.swExtrudeFrom_e.swExtrudeFrom_Offset
Debug.Print " from: offset 从等距"
Debug.Print " distance等距距离 = " & swExtrusionData.FromOffsetDistance
Debug.Print " reverse等距方向 = " & swExtrusionData.FromOffsetReverse
Set Sketchplane = SwSketch.GetReferenceEntity(nEntType) '因为原来FromEntity为空值,所以通过草图得到基准面或平面或曲面
If swExtrusionData.FromOffsetReverse Then
Depth = swModel.ClosestDistance(SwEndConRef, Sketchplane, vPoint1, vPoint2) + swExtrusionData.FromOffsetDistance '计算终止对象与草图平面的距离再加等距距离
Else
Depth = swModel.ClosestDistance(SwEndConRef, Sketchplane, vPoint1, vPoint2) - swExtrusionData.FromOffsetDistance '计算终止对象与草图平面的距离再减等距距离
End If
Case SwConst.swExtrudeFrom_e.swExtrudeFrom_SurfaceFacePlane
Debug.Print " from: surface 从曲面/面/基准面"
Depth = swModel.ClosestDistance(SwEndConRef, FromEntity, vPoint1, vPoint2) '计算终止对象与开始对象的距离
Case SwConst.swExtrudeFrom_e.swExtrudeFrom_Vertex
Debug.Print " from: vertex 从顶点"
Set Sketchplane = SwSketch.GetReferenceEntity(nEntType) '因为原来FromEntity为空值,所以通过草图得到基准面或平面或曲面
Depth = swModel.ClosestDistance(SwEndConRef, Sketchplane, vPoint1, vPoint2) - swModel.ClosestDistance(FromEntity, Sketchplane, vPoint3, vPoint4) '两个距离计算值相差
End Select
If Depth = -1# Then
Debug.Print "无法计算距离起始曲面与终点对象的距离,执行退出no solution"
GoTo nextdo
End If
Debug.Print " Depth = " & Depth * 1000# & " mm"
swExtrusionData.SetEndCondition Forward, swEndCondBlind '改终止条件为"拉伸深度"
swExtrusionData.SetDepth Forward, Depth '赋拉伸值
nextdo:
Forward = False
Next I
boolstatus = swFeat.ModifyDefinition(swExtrusionData, swModel, Nothing) '修改参数重建
swExtrusionData.ReleaseSelectionAccess '释放特征参数
swModel.Rebuild (1) '重建以免合并结果未更新错误
'swModel.ClearSelection2 True '清除选择
End Sub