Quantcast
Channel: Manufacturing DevBlog
Viewing all articles
Browse latest Browse all 532

GetExistingFacets and CalculateFacets

$
0
0

By Adam Nagy

You can use these two functions to get the tessellated geometry of an Inventor model. If calculated values already exist then you can get the tolerance they are using via GetExistingFacetTolerances. If this gives back some values then you can use them to retrieve the associated facets through GetExistingFacets, where you would pass in the existing tolerance of your choice. 

If the existing facets used a tolerance that is not precise enough for you, then you need to use CalculateFacets

The relationship between the values that GetExistingFacets/CalculateFacets return can be explained using a simple rectangular face as an example - the order of the values could differ from the below example but the relationship between them should be the same. If we called CalculateFacets(Tolerance As Double, VertexCount As Long, FacetCount As Long, VertexCoordinates() As Double, NormalVectors() As Double, VertexIndices() As Long) on the below face, we would get these values:

CalculateFacets
There are some samples in the API Help file showing how to use these functions, but here is one that can be useful to debug things. This will show if an acceptable tolerance already exists, in which case the lines will be green otherwise red. You can also then examine the result to see if e.g. for some reason the vertices of neighbouring faces do not line up, like here:

CalculateFacets1
When using the same tolerance to retrieve existing facets, then they should line up between neighbouring faces. If not, then regenerating the model should put things right - i.e. PartDocument.Rebuild():

CalculateFacets2

Here is the VBA sample code for vertex checking:

Sub ShowFacetLines( _
  vCount As Long, fCount As Long, coords() As Double, _
  normals() As Double, indices() As Long, _
  oGraphicNode As GraphicsNode, oDataSets As GraphicsDataSets, _
  existing As Boolean)
  Dim oCoordSet As GraphicsCoordinateSet
  Set oCoordSet = oDataSets.CreateCoordinateSet(oDataSets.count + 1)
  Call oCoordSet.PutCoordinates(coords)

  Dim oCoordIndexSet As GraphicsIndexSet
  Set oCoordIndexSet = oDataSets.CreateIndexSet(oDataSets.count + 1)

  Dim oColorSet As GraphicsColorSet
  Set oColorSet = oDataSets.CreateColorSet(oDataSets.count + 1)

  If existing Then
    Call oColorSet.Add(1, 0, 255, 0)
  Else
    Call oColorSet.Add(1, 255, 0, 0)
  End If

  Dim oColorIndexSet As GraphicsIndexSet
  Set oColorIndexSet = oDataSets.CreateIndexSet(oDataSets.count + 1)

  Dim i As Integer
  For i = 0 To fCount - 1
    Call oCoordIndexSet.Add( _
      oCoordIndexSet.count + 1, indices(i * 3))
    Call oCoordIndexSet.Add( _
      oCoordIndexSet.count + 1, indices(i * 3 + 1))
    Call oCoordIndexSet.Add( _
      oCoordIndexSet.count + 1, indices(i * 3 + 1))
    Call oCoordIndexSet.Add( _
      oCoordIndexSet.count + 1, indices(i * 3 + 2))
    Call oCoordIndexSet.Add( _
      oCoordIndexSet.count + 1, indices(i * 3 + 2))
    Call oCoordIndexSet.Add( _
      oCoordIndexSet.count + 1, indices(i * 3))

    Call oColorIndexSet.Add(oColorIndexSet.count + 1, 1)
    Call oColorIndexSet.Add(oColorIndexSet.count + 1, 1)
    Call oColorIndexSet.Add(oColorIndexSet.count + 1, 1)
  Next

  Dim oLine As LineGraphics
  Set oLine = oGraphicNode.AddLineGraphics
  oLine.CoordinateSet = oCoordSet
  oLine.CoordinateIndexSet = oCoordIndexSet
  oLine.ColorSet = oColorSet
  oLine.ColorIndexSet = oColorIndexSet
End Sub

Sub ShowFacets()
  Dim oDoc As PartDocument
  Set oDoc = ThisApplication.ActiveDocument

  Dim oDef As PartComponentDefinition
  Set oDef = oDoc.ComponentDefinition

  Dim tol As Double
  tol = Val(InputBox("Tolerance", "Provide Facet Tolerance", "0.1"))

  Dim tr As Transaction
  Set tr = ThisApplication.TransactionManager.StartTransaction( _
    oDoc, "ShowFacets")' Get the object to draw into
  On Error Resume Next
  Dim oClientGraphics As ClientGraphics
  Set oClientGraphics = oDef.ClientGraphicsCollection("MyTest")
  If Err = 0 Then
    oClientGraphics.Delete
  End If
  Set oClientGraphics = _
    oDef.ClientGraphicsCollection.AddNonTransacting("MyTest")' Create the graphics data sets collection
  Dim oDataSets As GraphicsDataSets
  Set oDataSets = oDoc.GraphicsDataSetsCollection("MyTest")
  If Err = 0 Then
    oDataSets.Delete
  End If
  Set oDataSets = _
    oDoc.GraphicsDataSetsCollection.AddNonTransacting("MyTest")
  On Error GoTo 0
  Dim vCount As Long
  Dim fCount As Long
  Dim coords() As Double
  Dim normals() As Double
  Dim indices() As Long

  Dim oSurf As SurfaceBody
  For Each oSurf In oDef.SurfaceBodies
    Dim oGraphicNode As GraphicsNode
    Set oGraphicNode = oClientGraphics.AddNode( _
      oClientGraphics.count + 1)
      
    ' Check if a good enough tolerance already exists
    Dim tCount As Long
    Dim tols() As Double
    Call oSurf.GetExistingFacetTolerances( _
      tCount, tols)
    Dim usedTol As Double
    usedTol = 0
    Dim msg As String
    msg = "Available tolerances:" + vbCrLf' They seem to be ordered from' smallest to biggest
    Dim i As Integer
    For i = tCount - 1 To 0 Step -1
      msg = msg + str(tols(i)) + vbCrLf
      If usedTol = 0 And tols(i) <= tol Then
        usedTol = tols(i)
      End If
    Next' If we found good existing' tolerance
    If usedTol > 0 Then
      Call oSurf.GetExistingFacets( _
        usedTol, _
        vCount, _
        fCount, _
        coords, _
        normals, _
        indices)
      Call ShowFacetLines( _
        vCount, fCount, coords, _
        normals, indices, oGraphicNode, oDataSets, True)
      msg = msg + "Using tolerance: " + str(usedTol)
      Call MsgBox(msg, vbInformation, "Used existing tolerance")
    Else
      Call oSurf.CalculateFacets( _
        tol, _
        vCount, _
        fCount, _
        coords, _
        normals, _
        indices)
      Call ShowFacetLines( _
        vCount, fCount, coords, _
        normals, indices, oGraphicNode, oDataSets, False)
      Call MsgBox(str(tol), vbInformation, "Used new tolerance")
    End If
  Next

  Call tr.End
  
  oDoc.Update
End Sub

Viewing all articles
Browse latest Browse all 532

Trending Articles