Total number of piercings in a sheet metal part

[Anonymous]

Hello,

I have been trying to create a macro that would add a custom property to my sheet metal parts that would tell me the total number of piercings in the part (holes and punches). So far I have the punches to count correctly but I am having issues with the holes, as I am getting an error. Any ideas?

Sub Piercings()
  'Get the part doc and sheet metal component defn.  No error handling:
  Dim oPartDocument As Inventor.PartDocument
  Set oPartDocument = ThisApplication.ActiveDocument
  Dim oSheetMetalComp As Inventor.SheetMetalComponentDefinition
  Set oSheetMetalComp = oPartDocument.ComponentDefinition
  'Dim oHoles As Inventor.HoleTables
  'Set oHoles = oPartDocument.ComponentDefinition
 
  'Get the pierce count
  Dim iHoleCount As Integer
  'iHoleCount = oHoles.Count
  Dim iPunchCount As Integer
  iPunchCount = oSheetMetalComp.FlatPattern.FlatPunchResults.Count
  Dim iPierceCount As Integer
  iPierceCount = iHoleCount + iPunchCount
  
  'Get the custom property set
  Dim oCustomProps As Inventor.PropertySet
  Set oCustomProps = oPartDocument.PropertySets.Item("Inventor User Defined Properties")
  
  'Define the name of the PIERCING count iproperty name:
  Dim sPiercePropName As String
  sPiercePropName = "PIERCINGS"
  
  'See if we already have an iproperty for the PIERCING count
  Dim oPierceProp As Inventor.Property
  Dim oProp As Inventor.Property
  For Each oProp In oCustomProps
    If oProp.Name = sPiercePropName Then
      'We already have an iproperty, we just need to write the new value
      Set oPierceProp = oProp
      oPierceProp.Value = iPierceCount
      Exit Sub
    End If
  Next oProp
  
  'We don't have an iproperty, so we create it and set its value
  If oPierceProp Is Nothing Then Set oPierceProp = oCustomProps.Add(iPierceCount, sPiercePropName)

End Sub

[brendan.henderson]

I have a macro that counts the pierces (for laser/plasma cutter). It counts all internal holes/shapes and then adds 1 for the uter shape. Let me know if this is of any interest to you.

[Anonymous]

Hello,

That would be great. That sounds like it will do what I am looking for.

Thank you,

Kyle

[jletcher]

This may help you in what you are asking

http://forums.autodesk.com/t5/Autodesk-Inventor-Customization/ilogic-to-count-features/td-p/3578618

[Anonymous]

I am looking to count the total number of holes not just the hole features in the part.

Thank you.

[jletcher]

I understand... you will have to add the code for cut command and other command features you used.

Just thught it would help..

[brendan.henderson · Accepted solution]

Here is the VBA code I use. It creates 4 custm iProperties being OuterPerimeter, InnerPerimeters, TotalPerimeter and Pierces. I didn't write it (I think the author may have passed on) but I use it 100 times a day and it just works. Edit to suit your needs.

Sub GetIntExtPerimeters()

    Dim oPartDoc As Document
    Set oPartDoc = ThisApplication.ActiveDocument
    Dim oFlatPattern As FlatPattern

    ' Check for a non-part document
    If oPartDoc.DocumentType <> kPartDocumentObject Then
        MsgBox "The Active document must be a 'Part'!"
        Exit Sub
    End If

    ' The Active document must be a Sheet metal Part
    If oPartDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
        MsgBox "The 'Part' must be a Sheet Metal Part!"
        Exit Sub
    End If
       
    ' Check to see if the flat pattern exists.
    Set oFlatPattern = oPartDoc.ComponentDefinition.FlatPattern
    If oFlatPattern Is Nothing Then
        MsgBox "No flat pattern exists for this part!"
        Exit Sub
    End If
    
    Dim oSheetMetalCompDef As SheetMetalComponentDefinition
    Set oSheetMetalCompDef = oPartDoc.ComponentDefinition

    ' Get the cut length
    Dim oFace As Face
    Set oFace = oSheetMetalCompDef.FlatPattern.TopFace

    ' Find the outer loop.
    Dim dOuterLength As Double
    dOuterLength = 0
    Dim oLoop As EdgeLoop
    For Each oLoop In oFace.EdgeLoops
        If oLoop.IsOuterEdgeLoop Then
            Dim oEdge As Edge
            For Each oEdge In oLoop.Edges
                ' Get the length of the current edge.
                Dim dMin As Double, dMax As Double
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Dim dLength As Double
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
                dOuterLength = dOuterLength + dLength
            Next
            'MsgBox "Outer Loop is " & FormatNumber(dOuterLength, 1)
            Exit For
        End If
    Next

    ' Iterate through the inner loops.
    Dim iLoopCount As Long
    iLoopCount = 0
    Dim dTotalLength As Double
    For Each oLoop In oFace.EdgeLoops
        Dim dLoopLength As Double
        dLoopLength = 0
        If Not oLoop.IsOuterEdgeLoop Then
            For Each oEdge In oLoop.Edges
                ' Get the length of the current edge.
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
                dLoopLength = dLoopLength + dLength
            Next

            ' Add this loop to the total length.
            dTotalLength = dTotalLength + dLoopLength
            'MsgBox "Inner Loops are " & FormatNumber(dTotalLength, 1)
        End If
    Next
    
'added by BH 13-07-2011-count edges to calculate peirces
Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oDef As SheetMetalComponentDefinition
Set oDef = oDoc.ComponentDefinition

Set oFlatPattern = oDef.FlatPattern

Dim oTransaction As Transaction
Set oTransaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "FindArea ")

Dim oSketch As PlanarSketch
Set oSketch = oFlatPattern.Sketches.Add(oFlatPattern.TopFace)

Dim oEdgeLoop As EdgeLoop

numLoops = 1
For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
    If oEdgeLoop.IsOuterEdgeLoop = False Then
        numLoops = numLoops + 1
    End If
Next

TotalPierces = numLoops

For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
    If oEdgeLoop.IsOuterEdgeLoop Then
        Exit For
    End If
Next

For Each oEdge In oEdgeLoop.Edges
    Call oSketch.AddByProjectingEntity(oEdge)
Next

Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid

oTransaction.Abort
'end

    Dim oUOM As UnitsOfMeasure
    Set oUOM = oPartDoc.UnitsOfMeasure
    outerCutlength = oUOM.GetStringFromValue(dOuterLength, kMillimeterLengthUnits)
    innerCutlength = oUOM.GetStringFromValue(dTotalLength, kMillimeterLengthUnits)
    TotalCutLength = oUOM.GetStringFromValue(dTotalLength + dOuterLength, kMillimeterLengthUnits)
    
    'Write data to properties, creating or updating (if property exists)
    Dim oCustomPropSet As PropertySet
    Set oCustomPropSet = oPartDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")

    On Error Resume Next
    oCustomPropSet.Item("OuterPerimeter").Value = outerCutlength
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(outerCutlength, "OuterPerimeter")
    End If
    oCustomPropSet.Item("InnerPerimeters").Value = innerCutlength
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(innerCutlength, "InnerPerimeters")
    End If
    oCustomPropSet.Item("TotalPerimeter").Value = TotalCutLength
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(TotalCutLength, "TotalPerimeter")
    End If
    
    'added by BH 13-07-2011
    oCustomPropSet.Item("Pierces").Value = TotalPierces
    If Err Then
        Err.Clear
        Call oCustomPropSet.Add(TotalPierces, "Pierces")
    End If
    End
    
End Sub

[Anonymous]

Thanks!

I got that to work.

I simplified it to do just what I want it to do.

Sub Piercings()
  Dim oPartDoc As Inventor.PartDocument
  Set oPartDoc = ThisApplication.ActiveDocument
  Dim oSheetMetalComp As Inventor.SheetMetalComponentDefinition
  Set oSheetMetalComp = oPartDoc.ComponentDefinition
  Dim oFlatPattern As FlatPattern
  Set oFlatPattern = oSheetMetalComp.FlatPattern
  Dim oEdgeLoop As EdgeLoop
  Dim numLoops As Integer
  numLoops = 0
  For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
    If oEdgeLoop.IsOuterEdgeLoop = False Then
        numLoops = numLoops + 1
    End If
  Next
  Dim TotalPierces As Integer
  TotalPierces = numLoops
  Dim oCustomProps As Inventor.PropertySet
  Set oCustomProps = oPartDoc.PropertySets.Item("Inventor User Defined Properties")
  Dim sPiercePropName As String
  sPiercePropName = "PIERCINGS"
  Dim oPierceProp As Inventor.Property
  Dim oProp As Inventor.Property
  For Each oProp In oCustomProps
    If oProp.Name = sPiercePropName Then
      Set oPierceProp = oProp
      oPierceProp.Value = TotalPierces
      Exit Sub
    End If
  Next oProp
  If oPierceProp Is Nothing Then Set oPierceProp = oCustomProps.Add(TotalPierces, sPiercePropName)
End Sub