获取焊缝的轮廓

有客户问道如何得知焊缝的轮廓，其实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.Update

End Sub