Dobrý den, 
pokouším se pro Inventor napsat utilitku ve vb.net, která by uměla do plechu se čtyřmi děrami  pro šrouby
s konstantní roztečí 110 mm
, vložit čtyři šrouby (nejlépe jako pole) do těchto děr, pokud označím jen jednu hranu otvoru pro šroub viz. obr.Hranu vybírám pomocí Dim partEdge As Edge partEdge = m_inventorApp.CommandManager.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a circular edge.")Vše funguje, akorát nevím jak udělat to, aby šrouby vždy zapadly do děr, to znamená, že ať vyberu jakoukoliv ze čtyř děr, šrouby si najdou zbývající tři a ne jako na obrázku, kdy je natvrdo dán směr vyplnění pole komponent.Pole komponent vkládám následovněoAssyDef.OccurrencePatterns.AddRectangularPattern(objCol, oWorkAxesX, True, -11, no_x_rect, oWorkAxesY, True, -11, no_y_rect)Celý kód je pod obrázkem.R.M..Imports SystemImports System.Collections.GenericImports System.LinqImports System.TextImports InventorImports System.Runtime.InteropServicesPublic Class osy Public Sub Main()    'vloží šroub a připojí ho k označené díře Dim m_inventorApp As Inventor.Application = Nothing m_inventorApp = System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application") Dim asmDoc As AssemblyDocument asmDoc = m_inventorApp.ActiveDocument ' Have the user select a circular edge. Dim partEdge As Edge partEdge = m_inventorApp.CommandManager.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a circular edge.") If partEdge Is Nothing Then Exit Sub End If ' Place the bolt into the assembly. Dim boltOcc As ComponentOccurrence  boltOcc = asmDoc.ComponentDefinition.Occurrences.Add("e:\******\Atributy_HV_M20-105_(68-72).ipt", m_inventorApp.TransientGeometry.CreateMatrix) ' Get the part document of the bolt. Dim boltDoc As PartDocument boltDoc = boltOcc.Definition.Document ' Query the attributes in the part for the attribute set named "InsertEdge". Dim attribSets As AttributeSetsEnumerator attribSets = boltDoc.AttributeManager.FindAttributeSets("InsertEdge") 'attribSets = boltDoc.AttributeManager.FindAttributeSets("*") ' Assume success and get the parent from first item returned, ' which will be the edge. Dim boltEdge As Edge boltEdge = attribSets.Item(1).Parent.Parent ' Create a proxy for the edge. Dim boltEdgeProxy As EdgeProxy boltOcc.CreateGeometryProxy(boltEdge, boltEdgeProxy) ' Create a constraint. asmDoc.ComponentDefinition.Constraints.AddInsertConstraint(partEdge, boltEdgeProxy, True, 0) Dim oAssyDoc As AssemblyDocument oAssyDoc = m_inventorApp.ActiveDocument Dim oAssyDef As AssemblyComponentDefinition oAssyDef = oAssyDoc.ComponentDefinition If oAssyDef.Occurrences.Count < 2 Then MsgBox("Assembly must have 2 components") Exit Sub End If 'Dim Occurrence As ComponentOccurrenceProxy Dim Occurrence As ComponentOccurrence Occurrence = partEdge.Parent.Parent Dim XAxis As WorkAxis Dim YAxis As WorkAxis Dim Zaxis As WorkAxis ' With oAssyDef With Occurrence.Definition XAxis = .WorkAxes.Item(1) YAxis = .WorkAxes.Item(2) Zaxis = .WorkAxes.Item(3) End With Dim oWorkAxesX As WorkAxisProxy Occurrence.CreateGeometryProxy(XAxis, oWorkAxesX) Dim oWorkAxesY As WorkAxisProxy Occurrence.CreateGeometryProxy(YAxis, oWorkAxesY) 'Create an object collection Dim objCol As ObjectCollection objCol = m_inventorApp.TransientObjects.CreateObjectCollection() 'add the desired occurrence to be patterned objCol.Add(oAssyDef.Occurrences.ItemByName(boltOcc.Name)) 'set the number of patterns in the x direction Dim no_x_rect As Integer no_x_rect = 2 'set the number of patterns in the y direction Dim no_y_rect As Integer no_y_rect = 2 'Creating a Rectangular pattern oAssyDef.OccurrencePatterns.AddRectangularPattern(objCol, oWorkAxesX, True, -11, no_x_rect, oWorkAxesY, True, -11, no_y_rect) End SubEnd Class 
spratek2015-08-19 15:35:05

Já bych asi zkusil najít odpovídající hranu k té vybrané na prvním elementu pole. Jako bonus dostanu to pole a jeho parametry. Tohle je iLogic kód pro jeden z mnoha způsobů, jak to udělat. [code]Sub Main()    Dim oEdgeProxy As EdgeProxy = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select edge")    Dim rectPattern As RectangularPatternFeatureProxy = Nothing    Dim result As EdgeProxy = GetFirstEdge(oEdgeProxy, rectPattern)    ThisApplication.ActiveDocument.SelectSet.Clear()    ThisApplication.ActiveDocument.SelectSet.Select(result)End SubFunction GetFirstEdge(ByVal oEdgeProxy As EdgeProxy, ByRef rectPattern As RectangularPatternFeatureProxy) As EdgeProxy    Dim pattern As RectangularPatternFeatureProxy = Nothing    For Each oFaceProxy As FaceProxy In oEdgeProxy.Faces        If oFaceProxy.CreatedByFeature.Type = ObjectTypeEnum.kRectangularPatternFeatureProxyObject Then            pattern = oFaceProxy.CreatedByFeature            Exit For        End If    Next    rectPattern = pattern    If pattern Is Nothing Then        Return oEdgeProxy    End If    Dim holeProxy As HoleFeatureProxy = pattern.ParentFeatures(1)    Dim edgeCircle As Circle = oEdgeProxy.Geometry    Dim edgePlane As Plane = ThisApplication.TransientGeometry.CreatePlane(edgeCircle.Center, edgeCircle.Normal.AsVector())    For Each holeFace As FaceProxy In holeProxy.Faces        For Each holeEdge As EdgeProxy In holeFace.Edges            If holeEdge.GeometryType <> CurveTypeEnum.kCircleCurve Then Continue For            Dim holeCircle As Circle = holeEdge.Geometry            'Check radius            If Math.Abs(edgeCircle.Radius - holeCircle.Radius) > 0.0001 Then Continue For            'Check distance            Dim holePlane As Plane = ThisApplication.TransientGeometry.CreatePlane(holeCircle.Center, holeCircle.Normal.AsVector())            Dim MinimumDistance As Double = ThisApplication.MeasureTools.GetMinimumDistance(edgePlane, holePlane)            If MinimumDistance < 0.0001 Then                Return holeEdge            End If        Next    Next    'Default result    rectPattern = Nothing    Return oEdgeProxyEnd Function[/code]

Děkuji za zaslaný kód, myslím, že přesně toto jsem potřeboval. Zjistil jsem u toho ale jenden malý problém.Ten tkví v tom, že když vyberu hranu díry, která je na první pozici pole, které tvoří díry, funkce GetFirstEdge vrací hodnotu rectPattern=nothing. Mě by spíše vyhovovalo, aby tato hodnota vždy vracela vlastnoti pole, ze kerého bych potom nějak vypreparoval vlastnosti použitelné pro moje pole se šrouby. Je možné GetFirstEdge upravit tak, aby hodnotu rectPattern vracela vždy?Ještě jednou díky za případné postřehy. 

Na to žádná přímočará metoda není. Prvek díra o sobě neříká, že je zdrojem pro nějaké pole.

Nakonec jsem to musel vyřešit pomocí funkce FindUsingPoint(). Jednak toto řešení funguje za všech situací a ještě jednoduše určím tloušťku spojovaného materiálu pro volbu délky šroubu. Sice se o něco prodlouží běh programu, ale pořád je to akceptovatelné.Pro inspiraci kód přikládám. [CODE]Imports InventorPublic Class MB_Spojovak Public Sub MB_Spojovak() Dim m_inventorApp As Inventor.Application = Nothing m_inventorApp = System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application") Dim oAssyDoc As AssemblyDocument oAssyDoc = m_inventorApp.ActiveDocument Dim oAssyDef As AssemblyComponentDefinition oAssyDef = oAssyDoc.ComponentDefinition ' Have the user select a circular edge. Dim partEdge As Edge partEdge = m_inventorApp.CommandManager.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a circular edge.") 'když nic nevybereš exit If partEdge Is Nothing Then Exit Sub End If 'Dim Occurrence As ComponentOccurrenceProxy Dim Occurrence As ComponentOccurrence Occurrence = partEdge.Parent.Parent Dim dira_1 As Inventor.Circle 'Circ1 dira_1 = partEdge.Geometry 'Circ1 Dim dira_1_stred As Point dira_1_stred = dira_1.Center 'najde všechny středy děr v zadané vzdálenosti (v tomto případě 12 cm) Dim najdu_center As ObjectsEnumerator Dim filtr_new As Inventor.SelectionFilterEnum() filtr_new = New Inventor.SelectionFilterEnum(0) {Inventor.SelectionFilterEnum.kAllCircularEntities} najdu_center = oAssyDef.FindUsingPoint(dira_1.Center, filtr_new, 11.001, True) 'pokud něco najde provede akci If najdu_center.Count > 0 Then Dim bod_pole(1) As Point Dim aa As Byte = 0 Dim diry As Object Dim distance As Double Dim stred As Point Dim osa(2) As Vector Dim boltOcc As ComponentOccurrence = Nothing 'projde všechny nalezené díry For i = 1 To najdu_center.Count diry = najdu_center.Item(i) 'zjistí vzdálenost mezi označenou dírou a nalezenou dírou distance = dira_1_stred.DistanceTo(diry.geometry.center) 'když je vzdálenost 110 mm pokračuje, vzdálenost zaokrouhluje na 5 desetinných míst If Math.Round(distance, 5) = 11.0 Then stred = diry.geometry.center 'v nalezeném středu vytvoří dočasný bod 'bod_pole(aa) = m_inventorApp.TransientGeometry.CreatePoint(stred.X, stred.Y, stred.Z) bod_pole(aa) = stred 'vytvoří vektor ve středu nalezené díry osa(aa) = m_inventorApp.TransientGeometry.CreateVector(bod_pole(aa).X, bod_pole(aa).Y, bod_pole(aa).Z) aa = 1 ElseIf Math.Round(distance, 1) = 5.0 Then  boltOcc = oAssyDoc.ComponentDefinition.Occurrences.Add("X:\XXX\HV_M24-85_(47-51).ipt", m_inventorApp.TransientGeometry.CreateMatrix) ' MsgBox("Distance " & " = " & distance & vbCrLf & "50 mm") ElseIf Math.Round(distance, 1) = 5.1 Then  boltOcc = oAssyDoc.ComponentDefinition.Occurrences.Add("X:\XXX\HV_M24-85_(47-51).ipt", m_inventorApp.TransientGeometry.CreateMatrix) 'MsgBox("Distance " & " = " & distance & vbCrLf & "51 mm") ElseIf Math.Round(distance, 1) = 6.0 Then  boltOcc = oAssyDoc.ComponentDefinition.Occurrences.Add("X:\XXX\HV_M24-100_(59-63).ipt", m_inventorApp.TransientGeometry.CreateMatrix) 'MsgBox("Distance " & " = " & distance & vbCrLf & "60 mm") ElseIf Math.Round(distance, 1) = 6.1 Then  boltOcc = oAssyDoc.ComponentDefinition.Occurrences.Add("X:\XXX\HV_M24-100_(59-63).ipt", m_inventorApp.TransientGeometry.CreateMatrix) ' MsgBox("Distance " & " = " & distance & vbCrLf & "61mm") Else MessageBox.Show("Tloušťka spojovaného materálu není v rozmezí 50-61mm." & vbCrLf & "Spoj budeš muset vytvořit sám.", "Nestandartní tl. spoj. mat.!") Exit Sub End If If Not (bod_pole(0) Is Nothing Or bod_pole(1) Is Nothing) Then Exit For End If Next i 'vytvoří vektor ve středu označené díry osa(2) = m_inventorApp.TransientGeometry.CreateVector(dira_1_stred.X, dira_1_stred.Y, dira_1_stred.Z) Dim Osa_Unit(1) As UnitVector Dim WorkAx(1) As WorkAxis For ii = 0 To 1 'rozdíl vektorů označené a nalezené díry osa(ii).SubtractVector(osa(2)) Osa_Unit(ii) = osa(ii).AsUnitVector 'WorkAx(i) = oAssyDef.WorkAxes.AddFixed(dira_1_stred, Osa_Unit(i)) Next ii Dim filtr_hrana As Inventor.SelectionFilterEnum() filtr_hrana = New Inventor.SelectionFilterEnum(0) {Inventor.SelectionFilterEnum.kPartEdgeLinearFilter} 'najde všechny lineární hrany kolem vybrané díry Dim hrana As ObjectsEnumerator hrana = oAssyDef.FindUsingPoint(dira_1_stred, filtr_hrana, 10, True) If hrana Is Nothing Then MsgBox("Nenašel jsem žádnou hranu, akce bude přerušena!") Exit Sub End If Dim oznac_x As Edge = Nothing Dim oznac_y As Edge = Nothing 'vybere dve hrany v modelu které mají stejný směr jako díry raprezentované vektorem For hr = 1 To hrana.Count Try If Osa_Unit(0).IsEqualTo(hrana.Item(hr).geometry.direction, 0.00001) And oznac_x Is Nothing Then 'oAssyDoc.SelectSet.Select(hrana.Item(hr)) 'MsgBox("je rovn_x") oznac_x = hrana.Item(hr) ElseIf Osa_Unit(1).IsEqualTo(hrana.Item(hr).geometry.direction, 0.00001) And oznac_y Is Nothing Then 'oAssyDoc.SelectSet.Select(hrana.Item(hr)) ' MsgBox("je rovn_y") oznac_y = hrana.Item(hr) End If Catch Ex As Exception ' MsgBox(Ex.ToString) End Try 'když najde odpovídající dvě hrany ukončí For If oznac_x Is Nothing Or oznac_y Is Nothing Then Else 'MsgBox("koncim") Exit For End If Next hr    ' Get the part document of the bolt. Dim boltDoc As PartDocument boltDoc = boltOcc.Definition.Document ' Query the attributes in the part for the attribute set named "InsertEdge". Dim attribSets As AttributeSetsEnumerator attribSets = boltDoc.AttributeManager.FindAttributeSets("HranaVlozeni") ' Assume success and get the parent from first item returned, ' which will be the edge. Dim boltEdge As Edge boltEdge = attribSets.Item(1).Parent.Parent ' Create a proxy for the edge. Dim boltEdgeProxy As EdgeProxy = Nothing boltOcc.CreateGeometryProxy(boltEdge, boltEdgeProxy) ' Create a constraint. oAssyDoc.ComponentDefinition.Constraints.AddInsertConstraint(partEdge, boltEdgeProxy, True, 0) 'Create an object collection Dim objCol As ObjectCollection objCol = m_inventorApp.TransientObjects.CreateObjectCollection() 'add the desired occurrence to be patterned objCol.Add(oAssyDef.Occurrences.ItemByName(boltOcc.Name)) 'set the number of patterns in the x direction Dim no_x_rect As Integer no_x_rect = 2 'set the number of patterns in the y direction Dim no_y_rect As Integer no_y_rect = 2 'vytvoří pole komponent oAssyDef.OccurrencePatterns.AddRectangularPattern(objCol, oznac_x, True, 11, no_x_rect, oznac_y, True, 11, no_y_rect) Else MsgBox("Nenašel jsem žádnou díru!" & vbCrLf & "Akce bude ukončena.") Exit Sub End If End SubEnd Class [/CODE]