在绘图视图中使用SOLIDWORKS API对命名模型实体进行标注
与装配上下文类似,绘图上下文也存在。指向实体的指针可能存在于底层模型上下文和绘图视图上下文中。
当需要在绘图视图中选择底层模型上下文中的实体(例如用于尺寸标注)时,可以调用IView::SelectEntity SOLIDWORKS API方法。SOLIDWORKS将自动在绘图视图中找到相应的实体指针并选择它。
此示例演示了如何使用SOLIDWORKS API在底层零件模型中的两个命名边(Edge1和Edge2)之间添加线性尺寸。可以通过以下属性对话框为实体命名:
{ width=350 }
结果是在边界之间添加了尺寸。
{ width=250 }
尺寸的位置是在两个边界的中点之间绘制的线的中点。与绘图中的图纸上下文不同,绘图工作表比例不需要在定位尺寸时乘以视图变换矩阵。
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swDraw As SldWorks.DrawingDoc
Set swDraw = swApp.ActiveDoc
If Not swDraw Is Nothing Then
Dim swView As SldWorks.view
Set swView = swDraw.SelectionManager.GetSelectedObject6(1, -1)
If Not swView Is Nothing Then
DimensionNamedEdges "Edge1", "Edge2", swDraw, swView
Else
MsgBox "请选择绘图视图"
End If
Else
MsgBox "请打开绘图文档"
End If
End Sub
Function DimensionNamedEdges(firstEdgeName As String, secondEdgeName As String, draw As SldWorks.DrawingDoc, view As SldWorks.view)
Dim swRefPart As SldWorks.PartDoc
Set swRefPart = view.ReferencedDocument
Dim swFirstEdge As SldWorks.edge
Set swFirstEdge = swRefPart.GetEntityByName(firstEdgeName, swSelectType_e.swSelEDGES)
Dim swSecondEdge As SldWorks.edge
Set swSecondEdge = swRefPart.GetEntityByName(secondEdgeName, swSelectType_e.swSelEDGES)
If swFirstEdge Is Nothing Or swSecondEdge Is Nothing Then
Err.Raise vbError, "", "未能按名称找到边界"
End If
If False = view.SelectEntity(swFirstEdge, False) Or False = view.SelectEntity(swSecondEdge, True) Then
Err.Raise vbError, "", "未能在绘图视图中选择边界"
End If
Dim swModel As SldWorks.ModelDoc2
Set swModel = draw
Dim vDimLoc As Variant
vDimLoc = GetDimensionLocation(swFirstEdge, swSecondEdge, view)
swModel.AddDimension2 vDimLoc(0), vDimLoc(1), vDimLoc(2)
End Function
Function GetDimensionLocation(firstEdge As SldWorks.edge, secondEdge As SldWorks.edge, view As SldWorks.view) As Variant
Dim vFirstPt As Variant
vFirstPt = GetEdgeMidPoint(firstEdge, view)
Dim vSecondPt As Variant
vSecondPt = GetEdgeMidPoint(secondEdge, view)
Dim dLoc(2) As Double
dLoc(0) = (vFirstPt(0) + vSecondPt(0)) / 2
dLoc(1) = (vFirstPt(1) + vSecondPt(1)) / 2
dLoc(2) = (vFirstPt(2) + vSecondPt(2)) / 2
GetDimensionLocation = dLoc
End Function
Function GetEdgeMidPoint(edge As SldWorks.edge, view As SldWorks.view) As Variant
Dim vStartPt As Variant
vStartPt = edge.GetStartVertex().GetPoint
Dim vEndPt As Variant
vEndPt = edge.GetEndVertex().GetPoint
Dim vMidPt(2) As Double
vMidPt(0) = (vStartPt(0) + vEndPt(0)) / 2
vMidPt(1) = (vStartPt(1) + vEndPt(1)) / 2
vMidPt(2) = (vStartPt(2) + vEndPt(2)) / 2
Dim swViewXForm As SldWorks.MathTransform
Set swViewXForm = view.ModelToViewTransform
Dim swMathUtils As SldWorks.MathUtility
Set swMathUtils = swApp.GetMathUtility
Dim swMathPt As SldWorks.MathPoint
Set swMathPt = swMathUtils.CreatePoint(vMidPt)
Set swMathPt = swMathPt.MultiplyTransform(swViewXForm)
GetEdgeMidPoint = swMathPt.ArrayData
End Function