Diskuzní fórum a databáze tipů a utilit pro AutoCAD, Inventor, Revit a další produkty Autodesk - od firmy CAD Studio [www.cadforum.cz]
Česky Slovensky English Deutsch
Přihlášení:
▶ Registrace

 právě čte: 6328 
RSS tipy RSS kanál - CAD tipy
RSS diskuze RSS kanál - CAD diskuze

Diskuze Diskuzní fórum

NápovědaCAD diskuze

CAD Fórum - Homepage Veřejné diskuzní fórum k CAD aplikacím - ptejte se na libovolné otázky týkající se oboru CAx, podělte se o vaše znalosti a zkušenosti s programy AutoCAD, Inventor, Revit a dalšími CAD aplikacemi. Zaregistrujte se nebo se přihlašte a zašlete váš příspěvek do odpovídajícího fóra. Viz další informace o CAD Fóru.
Fórum nenahrazuje technický support firmy CAD Studio - přímá podpora pro zákazníky funguje na helpdesk.cadstudio.cz
  FAQ FAQ  Prohledat fórum   Události   Registrovat Registrovat  Přihlásit Přihlásit

Téma uzavřenoInventor - vložení pole spojováku

 Odpovědět Odpovědět archiv
Autor
spratek Zobrazit panel
Nováček
Nováček

Přihlášen: 19.bře.2010
Lokalita: Czech Republic
Používám:
autocad2010
Stav: Offline
Bodů: 4
Přímý odkaz na tuto zprávu Téma: Inventor - vložení pole spojováku
    Zasláno: 19.srp.2015 v 13:19

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.



Připojené náhledyPřihlaste se pro zobrazení plné verze - 23776/OBR1.jpg

.

Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports Inventor
Imports System.Runtime.InteropServices


Public 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 Sub


End Class 



Upravil spratek - 19.srp.2015 v 15:35
Zpět nahoru
Navara Zobrazit panel
CAD Studio support
CAD Studio support
Avatar
CAD Studio a.s.

Přihlášen: 08.zář.2008
Lokalita: ČR (Pha)
Používám:
Inventor
Stav: Offline
Bodů: 887
Přímý odkaz na tuto zprávu Zasláno: 21.srp.2015 v 13:57
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.
 
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 Sub
Function 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 oEdgeProxy
End Function
Zpět nahoru
spratek Zobrazit panel
Nováček
Nováček

Přihlášen: 19.bře.2010
Lokalita: Czech Republic
Používám:
autocad2010
Stav: Offline
Bodů: 4
Přímý odkaz na tuto zprávu Zasláno: 24.srp.2015 v 16:10

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.


 


Zpět nahoru
Navara Zobrazit panel
CAD Studio support
CAD Studio support
Avatar
CAD Studio a.s.

Přihlášen: 08.zář.2008
Lokalita: ČR (Pha)
Používám:
Inventor
Stav: Offline
Bodů: 887
Přímý odkaz na tuto zprávu Zasláno: 24.srp.2015 v 16:16
Na to žádná přímočará metoda není. Prvek díra o sobě neříká, že je zdrojem pro nějaké pole.
Zpět nahoru
spratek Zobrazit panel
Nováček
Nováček

Přihlášen: 19.bře.2010
Lokalita: Czech Republic
Používám:
autocad2010
Stav: Offline
Bodů: 4
Přímý odkaz na tuto zprávu Zasláno: 29.zář.2015 v 10:44

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. 

Imports Inventor

Public 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 Sub
End Class 

Zpět nahoru

Pro technickou podporu CAD
kontaktujte Helpdesk

Příbuzné CAD tipy:
Tip 8616:Zalomení textu v rohovém razítku - iVlastnosti.
Tip 5735:Jaké je zorné pole kamery v AutoCADu?
Tip 11567:AttDefault resetuje atributy bloků na výchozí hodnoty.
Tip 11033:Hmotnost sestavy v závislosti na zvolené úrovni detailů.
Tip 11401:Operace s atributy uvnitř bloku - dynamické pole.
Tip 9837:Jak do výkresu vložit název použité tabulky stylu vykreslování?


 Odpovědět Odpovědět

Přejít na fórum Oprávnění fóra Zobrazit panel



Stránka byla vygenerována za 1,531 sekund.