跳到主要内容

从视图中使用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