获取焊缝的轮廓

来源:互联网 发布:java 多线程 锁 编辑:程序博客网 时间:2024/04/30 06:30

有客户问道如何得知焊缝的轮廓,其实WeldBead.BeadFaces 就返回焊缝的每个面,根据它们就能得知焊缝的轮廓。以下代码将这些面用Client Graphics的形式体现出来,为了和焊缝本身区分,故意将其偏移了一些位置。


Public Sub test()         'get document and definition     Dim oDoc As AssemblyDocument     Set oDoc = ThisApplication.ActiveDocument       Dim oCompDef As AssemblyComponentDefinition     Set oCompDef = oDoc.ComponentDefinition         'if this is a weld document     If oCompDef.Type = kWeldmentComponentDefinitionObject Then         Dim wcd As WeldmentComponentDefinition         Set wcd = oCompDef     Else         Exit Sub     End If        ' get one weld bead     Dim oWB As WeldBead     Set oWB = wcd.Welds.WeldBeads(1)       On Error Resume Next     Dim oClientGraphics As ClientGraphics     Set oClientGraphics = oCompDef.ClientGraphicsCollection.Item("weldbead")     If Err.Number = 0 Then         'delete the older client graphics, if any         On Error GoTo 0         oClientGraphics.Delete         ThisApplication.ActiveView.Update     End If        Err.Clear     On Error GoTo 0       ' create a client graphics     Set oClientGraphics = oCompDef.ClientGraphicsCollection.Add("weldbead")        'add graphics node     Dim oSurfacesNode As GraphicsNode     Set oSurfacesNode = oClientGraphics.AddNode(1)         'add the face of WeldBead.BeadFaces     Dim oSurfaceGraphics As SurfaceGraphics     Dim oEachWeldFace As Face     For Each oEachWeldFace In oWB.BeadFaces       Set oSurfaceGraphics = oSurfacesNode.AddSurfaceGraphics(oEachWeldFace)     Next         'set graphics' color. assume “Magenta” exists in the document     oSurfacesNode.Appearance = oDoc.Assets("Magenta")         'transform the client graphics to a location      Dim oTransGeom As TransientGeometry     Set oTransGeom = ThisApplication.TransientGeometry    Dim oV As Vector     Set oV = oTransGeom.CreateVector(10, 10, 10)    Dim oM As Matrix     Set oM = oTransGeom.CreateMatrix()     Call oM.SetTranslation(oV)    oSurfacesNode.Transformation = oM         'update the view     ThisApplication.ActiveView.UpdateEnd Sub

image
0 0