从视图中使用SOLIDWORKS API维度可见绘图实体

{ width=250 }

本示例演示了如何使用SOLIDWORKS API在所选绘图视图中的最长边上添加线性尺寸。

该宏遍历绘图视图中的所有可见实体，计算边的长度并找到最长的边。只有最长的边可以被维度化（即它是线性或圆形边），宏才能正常工作。

从IView::GetVisibleEntities返回的实体已经处于绘图视图上下文中，可以直接通过IEntity::Select4 SOLIDWORKS API方法选择，无需调用IView::SelectEntity函数。

尺寸的位置是通过将维度边的中点在法线曲线方向（切线方向和工作表Z轴的叉乘）上偏移边长的20%来计算的。与工作表上下文中的绘图不同，绘图工作表比例在定位尺寸时不需要乘以视图变换矩阵。

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
            DimensionLongestEdge swDraw, swView
        Else
            MsgBox "请选择绘图视图"
        End If
    Else
        MsgBox "请打开绘图文档"
    End If
    
End Sub

Sub DimensionLongestEdge(draw As SldWorks.DrawingDoc, view As SldWorks.view)
    
    Dim vVisComps As Variant
    vVisComps = view.GetVisibleComponents
    
    Dim i As Integer
    
    Dim swLongestEdge As SldWorks.edge
    Dim curMaxLength As Double
    
    curMaxLength = 0
    
    For i = 0 To UBound(vVisComps)
        
        Dim swComp As SldWorks.Component2
        Set swComp = vVisComps(i)
        Dim vVisEnts As Variant
        
        vVisEnts = view.GetVisibleEntities2(swComp, swViewEntityType_e.swViewEntityType_Edge)
        
        Dim j As Integer
        
        For j = 0 To UBound(vVisEnts)
            
            Dim swEdge As SldWorks.edge
            Set swEdge = vVisEnts(j)
            
            Dim curLength As Double
            curLength = GetEdgeLength(swEdge)
            
            If curLength > curMaxLength Then
                Set swLongestEdge = swEdge
                curMaxLength = curLength
            End If
            
        Next
        
    Next
    
    If swLongestEdge Is Nothing Then
        Err.Raise vbError, "", "找不到最长的边"
    End If
    
    Dim swEnt As SldWorks.Entity
    Set swEnt = swLongestEdge
    
    swEnt.Select4 False, Nothing
    
    Dim vDimLoc As Variant
    vDimLoc = GetDimensionLocation(swLongestEdge, view)
    
    draw.AddDimension2 vDimLoc(0), vDimLoc(1), vDimLoc(2)
    
End Sub

Function GetEdgeLength(edge As SldWorks.edge) As Double
    
    Dim swCurve As SldWorks.Curve
    
    Set swCurve = edge.GetCurve()
    
    Dim swCurveParams As SldWorks.CurveParamData
    Set swCurveParams = edge.GetCurveParams3
    
    GetEdgeLength = swCurve.GetLength3(swCurveParams.UMinValue, swCurveParams.UMaxValue)
    
End Function

Function GetDimensionLocation(edge As SldWorks.edge, view As SldWorks.view) As Variant
    
    Dim swCurveParams As SldWorks.CurveParamData
    Set swCurveParams = edge.GetCurveParams3
    
    Dim vCurveData As Variant
    vCurveData = edge.Evaluate2((swCurveParams.UMinValue + swCurveParams.UMaxValue) / 2, 2)
    
    Dim dMidPt(2) As Double
    dMidPt(0) = vCurveData(0): dMidPt(1) = vCurveData(1): dMidPt(2) = vCurveData(2)
    
    Dim dDir(2) As Double
    dDir(0) = vCurveData(3): dDir(1) = vCurveData(4): dDir(2) = vCurveData(5)
    
    Dim dimOffset As Double
    Dim swCurve As SldWorks.Curve
    Set swCurve = edge.GetCurve
    dimOffset = swCurve.GetLength3(swCurveParams.UMinValue, swCurveParams.UMaxValue) * 0.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(dMidPt)
    Set swMathPt = swMathPt.MultiplyTransform(swViewXForm)
    
    Dim swMathTangentVec As SldWorks.MathVector
    Set swMathTangentVec = swMathUtils.CreateVector(dDir)
    Set swMathTangentVec = swMathTangentVec.MultiplyTransform(swViewXForm)
    
    Dim swMathPerpVec As SldWorks.MathVector
    Dim dPerpVec(2) As Double
    dPerpVec(0) = 0: dPerpVec(1) = 0: dPerpVec(2) = 1
    Set swMathPerpVec = swMathUtils.CreateVector(dPerpVec)
    
    Dim swDimExtDir As SldWorks.MathVector
    Set swDimExtDir = swMathTangentVec.Cross(swMathPerpVec)
    
    GetDimensionLocation = MovePoint(swMathPt, swDimExtDir, dimOffset)
    
End Function

Function MovePoint(pt As SldWorks.MathPoint, dir As SldWorks.MathVector, dist As Double) As Variant
       
    Set dir = dir.Normalise()
    Set dir = dir.Scale(dist)
    
    Set pt = pt.AddVector(dir)
    
    MovePoint = pt.ArrayData
    
End Function