Hi @bradeneuropeArthur
I found an attribute for the specific path in the skeleton in the frame members document.
Then in the frame assembly i found an attribute describing the members in the frame with skeleton path, family and family row! With this code i could match the skeleton path from the specific frame member to the section of the assemblies attribute describing that member. Replacing the row number for the member in the assemblys attribute did the trick.
The code could use a bit of cleaning, but at least it works now 🙂
Imports Inventor
Public Class Form1
Dim invApp As Inventor.Application = GetObject(, "Inventor.Application")
Dim oDoc As AssemblyDocument = invApp.ActiveDocument
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
CustomMember_ChangeRow()
End Sub
Sub CustomMember_ChangeRow()
Dim i As Integer
Dim oAsmDoc As AssemblyDocument
oAsmDoc = invApp.ActiveDocument
Dim oAsmDef As AssemblyComponentDefinition
oAsmDef = oAsmDoc.ComponentDefinition
Dim oOcc As ComponentOccurrence
oOcc = invApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, "välj balk")
Dim oDef As PartComponentDefinition
oDef = oOcc.Definition
If oDef.IsContentMember Then
MsgBox("this sample works with the custom CC member only")
Exit Sub
Else
Debug.Print("It's a Custom CC member")
End If
Dim oDoc As PartDocument
oDoc = oDef.Document
Dim oProps As PropertySet
oProps = oDoc.PropertySets.Item("Content Library Component Properties")
Dim oProp As Inventor.Property
oProp = oProps.Item("FamilyId")
Dim FamilyId As String
FamilyId = oProp.Value
Dim oContentCenter As ContentCenter
oContentCenter = invApp.ContentCenter
Dim oFamily As ContentFamily
oFamily = oContentCenter.GetContentObject("v3#" + FamilyId + "#")
oProp = oProps.Item("MemberId")
Dim MemberId As String
MemberId = oProp.Value
Dim newRow As Integer
newRow = InputBox("Current Family row is " & MemberId _
& vbNewLine & vbNewLine & "New Family row:",
"New Family Row:", MemberId)
Dim oRow As ContentTableRow
oRow = oFamily.TableRows.Item(newRow)
Dim nCol As Integer
Dim oColumn As ContentTableColumn
Dim oPar As UserParameter
Dim oCustomProps As PropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
For Each oPar In oDef.Parameters.UserParameters
If oPar.DrivenBy.Count = 0 Then
nCol = -1
For i = 1 To oFamily.TableColumns.Count
If oFamily.TableColumns.Item(i).InternalName = oPar.Name Then
nCol = i
Exit For
End If
Next
If nCol <> -1 Then
oColumn = oFamily.TableColumns.Item(nCol)
If oColumn.KeyColumnOrder > 0 Then
Else
Dim units As String
units = oColumn.Units
Dim oCell As ContentTableCell
oCell = oRow.Item(nCol)
Dim value As String
value = oCell.Value & " " & units
oPar.Expression = value
Try
oCustomProps.Item(oPar.Name).Value = value
Catch ex As Exception
End Try
End If
End If
End If
Next
oProp = oProps.Item("MemberId")
oProp.Value = newRow
oProp = oProps.Item("Member Revision")
oProp.Value = CreateGuid()
For i = 1 To oFamily.TableColumns.Count
oColumn = oFamily.TableColumns.Item(i)
If oColumn.HasPropertyMap = True Then
Dim setid As String = String.Empty
Dim propid As String = String.Empty
Dim units As String
units = oColumn.Units
Try
If oColumn.InternalName <> "PARTNUMBER" Then
oColumn.GetPropertyMap(setid, propid)
Dim oExpression As String = oColumn.Expression
oExpression = Replace(Replace(oExpression, "&", ""), Chr(34), "")
Dim inS As String = oExpression
Dim oColl As New Collection
Dim s As String
Dim j As Integer, k As Integer
Do
j = InStr(1, inS, "{")
k = InStr(1, inS, "}")
If (j = 0) Or (k = 0) Then Exit Do
s = Mid$(inS, j + 1, k - j - 1)
If s <> "" Then
Call oColl.Add(s)
inS = Mid$(inS, k + 1, Len(inS))
End If
Loop Until s = ""
Dim ss As Object
For Each ss In oColl
Try
Dim oParam As UserParameter
Try
oParam = oDef.Parameters.UserParameters.Item(ss)
s = oParam.Expression
Debug.Print(s)
s = Microsoft.VisualBasic.Left$(s, InStr(s, " ") - 1)
Debug.Print(s)
Catch
s = ""
For colIndex = 1 To oFamily.TableColumns.Count
If oFamily.TableColumns.Item(colIndex).InternalName = ss Then
s = oRow.Item(colIndex).Value
Exit For
End If
Next
Debug.Print(s)
End Try
Catch
End Try
oExpression = Replace$(oExpression, "{" & ss & "}", s)
Next
Try
oDoc.PropertySets.Item(setid).ItemByPropId(propid).Value = oExpression &
If(units IsNot Nothing, " " & units, Nothing)
Catch
oDoc.PropertySets.Item(setid).Item(propid).Value = oExpression &
If(units IsNot Nothing, " " & units, Nothing)
End Try
End If
Catch
MsgBox("Failed to update: " & oColumn.InternalName)
End Try
End If
Next
ChangeAttributes(oOcc, newRow, FamilyId, GetPathID(oOcc))
oDoc.Update()
oDoc.Save()
oAsmDoc.Update()
oAsmDoc.Rebuild2()
Beep()
End Sub
Function GetPathID(oOcc As ComponentOccurrence) As String
Dim oDef As PartComponentDefinition = oOcc.Definition
Dim oDoc As PartDocument = oDef.Document
Dim FGPaths As String = oDoc.AttributeManager.FindAttributes("com.autodesk.FG*", "Paths", "*").Item(1).Value
Return FGPaths.Split("""")(1)
End Function
Sub ChangeAttributes(oOcc As ComponentOccurrence, newRow As Integer, FamilyID As String, oPath As String)
Dim oParent = oOcc.ContainingOccurrence
While True
Dim AttributesEnum As AttributesEnumerator = oParent.Definition.Document.AttributeManager.FindAttributes("com.autodesk.FG*", "Frame.Skeletons", "*")
If AttributesEnum.Count > 0 Then
Dim oS As String = AttributesEnum.Item(1).Value
Dim StartIndex As Integer = oS.IndexOf(oPath)
Dim oNewContent As Integer = oS.IndexOf("MonikerForNewContent", StartIndex)
Dim oNumber As Integer = oS.IndexOf(FamilyID, oNewContent)
Dim oMember As Integer = oS.IndexOf("#", oNumber) + 1
Dim oIntegers As Integer = 1
While True
If IsNumeric(oS(oMember + oIntegers)) Then
oIntegers += 1
Else
Exit While
End If
End While
oS = oS.Substring(0, oMember) & newRow & oS.Substring(oMember + oIntegers)
oNewContent = oS.IndexOf("MonikerForCC", StartIndex)
oNumber = oS.IndexOf(FamilyID, oNewContent)
oMember = oS.IndexOf("#", oNumber) + 1
oIntegers = 1
While True
If IsNumeric(oS(oMember + oIntegers)) Then
oIntegers += 1
Else
Exit While
End If
End While
oS = oS.Substring(0, oMember) & newRow & oS.Substring(oMember + oIntegers)
AttributesEnum.Item(1).Value = oS
Exit While
Else
Try
oParent = oParent.ContainingOccurrence
Catch
MsgBox("Error")
Exit While
End Try
End If
End While
End Sub
Private Function CreateGuid()
' Returns a unique Guid on every call. Removes any cruft.
' https://msdn.microsoft.com/en-us/subscriptions/sh9ete15(v=vs.84).aspx
' http://stackoverflow.com/questions/968756/how-to-generate-a-guid-in-vbscript
CreateGuid = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function
End Class