Message 1 of 7
iPart.FindRow in VBA
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello All, I'm trying to compose a code to create a new member of iPart straight from Assembly. Macro is doing what it should and for each iPart component is adding new row with value taken from user Parameter of assembly. My problem start when I have two iParts from the same iPartFactory, I end up with two iParts with the same value. I know that in iLogic there is a snippet Part.FindRow that would suit perfect to make an If condition, that when it's true row would change to existing else new row would be created. I cannot find similar solution in VBA. Can I count on your help?
Here is the code
Sub AddNewMember()
'originally determin variables
Dim oCompDef As Inventor.ComponentDefinition
Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition
Dim oCompOcc As ComponentOccurrence
Dim oFerCompDef As ComponentDefinition
Dim oiPart As iPartMember
' Get the active document. This assumes it is a assembly document.
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
' Get the Parameters collection.
Dim oParams As Parameters
Set oParams = oDoc.ComponentDefinition.Parameters
' Get the Parameter called "Length"
Dim oParam As Parameter
Set oParam = oParams.Item("Test1")
' Get the value of the parameter. This value is in the
' internal units of Inventor. If the parameter defines
' a length unit then the value is always returned in
' centimeters.
Dim dLength As Double
dLength = oParam.Value * 10
Debug.Print dLength
Dim oW As String
oW = CStr(dLength)
Debug.Print oW
For Each oCompOcc In oCompDef.Occurrences
If oCompOcc.IsiPartMember = True Then
Dim definitionMember As PartComponentDefinition
Set definitionMember = oCompOcc.Definition
Dim iPartMember As iPartMember
Set iPartMember = definitionMember.iPartMember
Dim factory As iPartFactory
Set factory = iPartMember.ParentFactory
Dim doc As PartDocument
Set doc = factory.Parent
Dim defintionFactory
Set definitionFactory = doc.ComponentDefinition
Debug.Print doc.FullFileName
' Open the factory document invisible.
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.Documents.Open(doc.FullFileName, False)
On Error Resume Next
Dim oFactory As iPartFactory
Set oFactory = oPartDoc.ComponentDefinition.iPartFactory
'Get the iPartTable
' If Err > 0 Or oFactory Is Nothing Then
' Exit Sub
' End If
' Get the part number used in the iPart table
Dim row As iPartTableRow
Set row = oFactory.TableRows.Item(oFactory.TableRows.Count)
Dim sPartNumber As String
If Not row Is Nothing Then
sPartNumber = row.MemberName
End If
Dim pos As Integer
pos = InStrRev(sPartNumber, "-")
Dim str As String
str = Left(sPartNumber, pos)
Member = Left(sPartNumber, pos - 1)
Dim iNumber As Integer
iNumber = Right(sPartNumber, Len(sPartNumber) - pos)
'Assume the off of the parameter's value (between two rows) is 0.5cm
Dim off As Double
off = 0.5
Dim oWorkSheet
Set oWorkSheet = oFactory.ExcelWorkSheet
Dim oCells
Set oCells = oWorkSheet.Cells
' New row's value...
If (iNumber + 1) < 100 Then
sPartNumber = str + "0" + CStr(iNumber + 1)
Else
sPartNumber = str + CStr(iNumber + 1)
End If
Dim oCell
oCell = oCells.Insert(, True)
oCells.Item(row.Index + 2, 1) = sPartNumber
oCells.Item(row.Index + 2, 2) = Member
oCells.Item(row.Index + 2, 3) = oW
' oCells.Item(row.Index + 2, 7) = "Include"
Dim oUM As UnitsOfMeasure
Set oUM = oPartDoc.UnitsOfMeasure
ThisApplication.CommandManager.ControlDefinitions.Item("DimensionDisplayEqn").Execute
Dim i As Integer
Dim oParameter As Parameter
For i = 4 To 4 + oPartDoc.ComponentDefinition.Parameters.UserParameters.Count
Set oParameter = FindParameterByName(oPartDoc, oCells.Item(1, i).Formula)
If oParameter.Name <> oPartDoc.ComponentDefinition.Parameters.UserParameters.Item(4).Name Then
oCells.Item(row.Index + 2, i) = oUM.GetStringFromValue(oParameter.Value + off * (row.Index), oParameter.Units)
Else
oCells.Item(row.Index + 2, i) = oPartDoc.ComponentDefinition.Parameters.UserParameters.Item(4).Expression
End If
Next
Set oUM = Nothing
Dim oWB
Set oWB = oWorkSheet.Parent
oWB.Save
oWB.Close
MsgBox ("Add a row - done!")
End If
Next
End Sub
Function FindParameterByName(oP As PartDocument, Nazwa As String) As Parameter
Dim i As Long
For i = 1 To oP.ComponentDefinition.Parameters.UserParameters.Count
If UCase(oP.ComponentDefinition.Parameters.UserParameters.Item(i).Name) = UCase(Nazwa) Then
Set FindParameterByName = oP.ComponentDefinition.Parameters.UserParameters.Item(i)
Exit For
End If
Next
End Function
