Issues with Proxys in Assembly
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello.
I have created two iLogic rules.
The first rule closes an existing round hole (from an imported STEP-file) with an extrusion and places a threaded hole at the former position. Mentioned here: ilogic-commandmanager-pick-wont-work-when-eop-marker-is-moved/
The second rule is meant to create an "irregular pattern" with the extrusion and the hole feature for all equal holes originated on the same face. Its not a real pattern (like the sketch pattern), cause i need all threaded holes in one feature for later processing. The rule works by projecting sketch-circles to the sketch and adding them as path segments to the extrusion and hole centerpoints to the hole feature.
At the moment both rules work within a Part-File but i want to use it out of an assembly also.
Rule number 1 works as expected.
Rule number 2 gives an error, when the remaining EdgeCircles should be projected.
"...dependencies...infinite loop..."
So the source and the destination are the same occurrence. I tried to separate both and the informations i got out of them. Making Proxys for faces, sketches, edges etc. but nothing will work.
So i hope someone can give me an hint to solve the problem.
Rule - 1 - Replace the hole with a threaded one
' Makro, dass eine Bohrung durch eine gleichgroße Extrusion verschließt und an der selben Stelle eine Gewindebohrung erstellt
' Gedacht um in importierten Modellen schnell musterbare Gewindebohrungen einzubringen, da die das Feature "Gewinde" nicht
' musterbar ist und bei größeren Mengen Bohrungen sehr zeitaufwändig
' nachdem Regel abgearbeitet ist, startet sie wieder von vorn
TheStart :
On Error GoTo ENDE
' Definition
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oEdDoc As Document = ThisApplication.ActiveEditDocument
Dim oApp As Inventor.Application = ThisApplication
Dim Bohrungstiefe As Double
Dim MaxDepth As Double
Dim Gewindetiefe As Double
Dim Steigung As Double
Dim Nennmass As String
Dim oStrMarker As String
oStrMarker = " (AUTO)"
If oDoc.DocumentType = kassemblyDocumentobject And Not oEdDoc.DocumentType = kpartdocumentobject Then
Dim Auswahl As Integer
Dim Message As String
Message = "Bohrung ersetzen ist nur in Einzelteilen möglich." & vbLf & vbLf & "Soll ein Einzelteil gewählt und die Bearbeitung wiederholt werden?"
Auswahl = MessageBox.Show(Message, "Achtung!", MessageBoxButtons.OKCancel)
If Auswahl = 1 Then
Dim oOcc As ComponentOccurrence
oOcc = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter , "Wähle eine Baugruppenkomponente aus.")
oOcc.Edit
GoTo TheStart
Else
GoTo Ende
End If
Else If oDoc.DocumentType = kassemblyDocumentobject And oEdDoc.DocumentType = kpartdocumentobject Then
oDoc = oEdDoc
' Definition der transienten Geometrie
Dim oTransGeom As TransientGeometry
oTransGeom = ThisApplication.TransientGeometry
' referenzieren der Komponenten Definition
Dim oCompDef As PartComponentDefinition
oCompDef = oDoc.ComponentDefinition
' Skizzenebene wählen
Dim oStartFace As Object = Nothing
oStartFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllPlanarEntities, "Startfläche wählen")
' zu ersetzende Bohrung wählen
Dim oHoleRef As Object = Nothing
oHoleRef = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceCylindricalFilter, "Bohrungsinnenfläche wählen")
Hole_Dia = oHoleRef.geometry.radius * 2 * 10 'Converted to Diameter and mm
' Endfläche der Bohrung wählen, entspricht auch der neuen Bohrungstiefe
Dim oEndFace As Object = Nothing
oEndFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Endfläche wählen")
' Bestimmung der Bohrungslänge, GetMinimumDistance hat bei nichtparallen und konischen Austrittsflächen immer Probleme gemacht.
Bohrungstiefe = (oHoleRef.Evaluator.Area * 10) / (2 * PI * oHoleRef.geometry.radius)
' Ist der Bohrlochstart konisch
Dim oCylEdge As Object
Dim oConnectedFace As Object
Dim bStartIsCone As Boolean
bStartIsCone = False
Dim oConicEdge As Object
Dim oRadConicEdge As Double
oRadConicEdge = 0
Dim oStartConeOuterEdge As Object
Dim oConeHight As Double
Dim oConeCX As Double
Dim oConeCY As Double
Dim oConeCZ As Double
For Each oCylEdge In oHoleRef.Edges
For Each oConnectedFace In oCylEdge.faces
If oConnectedFace.Surfacetype = kConeSurface And oConnectedFace.InternalName <> oEndFace.InternalName Then
bStartIsCone = True
For Each oConicEdge In oConnectedFace.edges
If oConicEdge.Geometry.Radius > oRadConicEdge Then
oRadConicEdge = oConicEdge.Geometry.Radius
oStartConeOuterEdge = oConicEdge
End If
Next
' Bestimmung der Höhe des Eingangskonus
If oConnectedFace.edges.count > 2 Then
Else
oConeCX = oConnectedFace.edges.Item(1).Geometry.center.X - oConnectedFace.edges.Item(2).Geometry.center.X
oConeCY = oConnectedFace.edges.Item(1).Geometry.center.Y - oConnectedFace.edges.Item(2).Geometry.center.Y
oConeCZ = oConnectedFace.edges.Item(1).Geometry.center.Z - oConnectedFace.edges.Item(2).Geometry.center.Z
oConeHight = Sqrt(oConeCX^2 + oConeCY^2 + oConeCZ^2)*10
End If
End If
Next
Next
' wenn der Bohrungsstart konisch ist, muss das auf die Bohrungstiefe aufgerechnet werden
If bStartIsCone = True Then
Bohrungstiefe = Bohrungstiefe + oConeHight
End If
' Ist die Endfläche ein Konus
Dim bEndIsCone As Boolean
If oEndFace.SurfaceType = kConeSurface Then
MaxDepth = Bohrungstiefe + oHoleRef.geometry.radius * 10 / Math.Tan(oEndFace.geometry.HalfAngle)
bEndIsCone = True
Else
MaxDepth = Bohrungstiefe
bEndIsCone = False
End If
' Wenn Endfläche ein Konus ist, wie viele Kanten hat er (bei mehr als 2 ist die Endfläche eine konische Außenfläche und kein Bohrlochgrund
Dim bConeNoHoleTip As Boolean
If bEndIsCone = True And oEndFace.Edges.Count > 2 Then
bConeNoHoleTip = True
Else
bConeNoHoleTip = False
End If
Dim bFlatHoleGround As Boolean
If oEndFace.SurfaceType = kPlaneSurface And oEndFace.Edges.Count = 1 Then
bFlatHoleGround = True
Else
bFlatHoleGround = False
End If
' Skizze erstellen
Dim oSketch As PlanarSketch = Nothing
oSketch = oCompDef.Sketches.Add(oStartFace.nativeobject)
oSketch.Edit
' Bohrungskante in Skizze projezieren
If bStartIsCone = True Then
Call oSketch.AddByProjectingEntity(oStartConeOuterEdge)
Else
If oHoleRef.Edges.Item(1).GeometryType <> kCircleCurve Then
Call oSketch.AddByProjectingEntity(oHoleRef.edges.Item(2).nativeobject)
Else
Call oSketch.AddByProjectingEntity(oHoleRef.edges.Item(1).nativeobject)
End If
End If
oSketch.ExitEdit
' Profil für die Extrusion wählen
Dim oProfile As Profile = Nothing
oProfile = oSketch.Profiles.AddForSolid
' Bohrung verschließen mit einer Extrusion bis zu angewählten Endfläche
Dim oExtrudeDef As ExtrudeDefinition
oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
'Wenn die Grundfläche ein Konus ist wird mit der maximalen Entfernung gerechnet, um die Bohrungstiefe zu erhalten
If bEndIsCone = True And bConeNoHoleTip = False Then
Call oExtrudeDef.SetDistanceExtent(MaxDepth / 10, kNegativeExtentDirection)
Else
Call oExtrudeDef.SetToExtent(oEndFace.nativeObject, kNegativeExtentDirection)
End If
Dim oExtrude As ExtrudeFeature
oExtrude = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
' Extrusion im Featurebaum kenntlich machen
oExtrude.Name = oExtrude.Name & oStrMarker
' Skizzenpunkt in der erstellten Skizze als Zentrum der neuen Bohrung definieren
oSketch.Edit
oHoleCenter1 = ThisApplication.TransientObjects.CreateObjectCollection
Dim oCoord1 As Point2d
oCoord1 = oTransGeom.CreatePoint2d(oSketch.SketchPoints.Item(1).Geometry.X + 5 , oSketch.SketchPoints.Item(1).Geometry.Y + 5)
oSketch.SketchPoints.Add(oCoord1)
oSketch.SketchPoints.Item(2).HoleCenter = True
oSketch.SketchPoints.Item(2).Merge (oSketch.SketchPoints.Item(1))
oHoleCenter1.Add(oSketch.SketchPoints.Item(1))
oSketch.ExitEdit
' Skizze wird verwendet von der Extrusion und der neuen Bohrung
oSketch.Shared = True
' Anhand vom ursprünglichen Bohrungsdurchmesser ein Nennmaß für das Gewinde wählen
Select Case Hole_Dia
Case <= 1.7
Nennmass = "M2x0.4"
Steigung = 0.4
Case <= 2.2
Nennmass = "M2.5x0.45"
Steigung = 0.45
Case <= 2.6
Nennmass = "M3x0.5"
Steigung = 0.5
Case <= 3.4
Nennmass = "M4x0.7"
Steigung = 0.7
Case <= 4.3
Nennmass = "M5x0.8"
Steigung = 0.8
Case <= 5.1
Nennmass = "M6x1"
Steigung = 1
Case <= 7
Nennmass = "M8x1.25"
Steigung = 1.25
Case <= 8.6
Nennmass = "M10x1.5"
Steigung = 1.5
Case <= 10.6
Nennmass = "M12x1.75"
Steigung = 1.75
Case <= 14.1
Nennmass = "M16x2"
Steigung = 2
Case <= 17.6
Nennmass = "M20x2.5"
Steigung = 2.5
Case <= 21.1
Nennmass = "M24x3"
Steigung = 3
Case <= 26.6
Nennmass = "M30x3.5"
Steigung = 3.5
Case <= 32.1
Nennmass = "M36x4"
Steigung = 4
Case <= 37.6
Nennmass = "M42x4.5"
Steigung = 4.5
Case <= 43.1
Nennmass = "M48x5"
Steigung = 5
Case <= 50.6
Nennmass = "M56x5.5"
Steigung = 5.5
Case Else
Nennmass = "M64x6"
Steigung = 6
End Select
' Gewindetiefe festlegen
Gewindetiefe = Bohrungstiefe - 3 * Steigung
If Gewindetiefe <= 0 Then
Gewindetiefe = Bohrungstiefe
End If
' Skizzenpunkt in der erstellten Skizze als Zentrum der neuen Bohrung definieren
oSketch.Edit
oSketch.SketchPoints.Item(1).HoleCenter = True
oSketch.ExitEdit
' Gewindebohrung erstellen
Dim oHoleTapInfo As HoleTapInfo
oHoleTapInfo = ThisApplication.ActiveEditDocument.ComponentDefinition.Features.HoleFeatures.CreateTapInfo _
(True, "ISO Metrisches Profil", Nennmass, "6H", False, Gewindetiefe / 10)
BottomTipAngle = 140 * PI / 180
If bEndIsCone = True And bConeNoHoleTip = False Then 'wenn Grundlochbohrung mit konischem Bohrungsgrund
oBohrung2 = ThisApplication.ActiveEditDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByDistanceExtent _
(oHoleCenter1, oHoleTapInfo, Bohrungstiefe / 10, PartFeatureExtentDirectionEnum.kPositiveExtentDirection, False, BottomTipAngle)
Else If bEndIsCone = True And bConeNoHoleTip = True Then 'Wenn Durchgangsbohrung mit konischer Endfläche
oBohrung2 = ThisApplication.ActiveEditDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByThroughAllExtent _
(oHoleCenter1, oHoleTapInfo, PartFeatureExtentDirectionEnum.kPositiveExtentDirection)
Else If bFlatHoleGround = True Then 'wenn Grundlochbohrung mit flachem Bohrlochgrund
oBohrung2 = ThisApplication.ActiveEditDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByDistanceExtent _
(oHoleCenter1, oHoleTapInfo, Bohrungstiefe/10, PartFeatureExtentDirectionEnum.kPositiveExtentDirection, False, BottomTipAngle)
Else 'Wenn Durchgangsbohrung und Endfläche ist Ebene (parallel oder nicht)
oBohrung2 = ThisApplication.ActiveEditDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByToFaceExtent _
(oHoleCenter1, oHoleTapInfo, oEndFace, True)
End If
' hat die Bohrung eine Eingangsfase, wird diese wieder hergestellt
If bStartIsCone = True Then
oBohrung2.SetCSink(oRadConicEdge*2,90*(PI/180) )
End If
' Extrusion im Featurebaum kenntlich machen
oBohrung2.name = oBohrung2.Name & oStrMarker
' Sichtbarkeit der Skizze deaktivieren
oSketch.Visible = False
' 'oDoc.Update
' oDoc.Update
ThisApplication.ActiveView.Update
' Wenn erfolgreich, dann beginne wieder am Start mit der nächsten Bohrung
GoTo TheStart :
Else If ThisApplication.ActiveDocument.Documenttype = kpartdocumentobject Then
' Definition der transienten Geometrie
Dim oTransGeom As TransientGeometry
oTransGeom = ThisApplication.TransientGeometry
' referenzieren der Komponenten Definition
Dim oCompDef As PartComponentDefinition
oCompDef = oDoc.ComponentDefinition
' Skizzenebene wählen
Dim oStartFace As Object = Nothing
oStartFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllPlanarEntities, "Startfläche wählen")
' zu ersetzende Bohrung wählen
Dim oHoleRef As Object = Nothing
oHoleRef = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceCylindricalFilter, "Bohrungsinnenfläche wählen")
Hole_Dia = oHoleRef.geometry.radius * 2 * 10 'Converted to Diameter and mm
' Endfläche der Bohrung wählen, entspricht auch der neuen Bohrungstiefe
Dim oEndFace As Object = Nothing
oEndFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Endfläche wählen")
' Bestimmung der Bohrungslänge, GetMinimumDistance hat bei nichtparallen und konischen Austrittsflächen immer Probleme gemacht.
Bohrungstiefe = (oHoleRef.Evaluator.Area * 10) / (2 * PI * oHoleRef.geometry.radius)
' Ist der Bohrlochstart konisch
Dim oCylEdge As Object
Dim oConnectedFace As Object
Dim bStartIsCone As Boolean
bStartIsCone = False
Dim oConicEdge As Object
Dim oRadConicEdge As Double
oRadConicEdge = 0
Dim oStartConeOuterEdge As Object
Dim oConeHight As Double
Dim oConeCX As Double
Dim oConeCY As Double
Dim oConeCZ As Double
For Each oCylEdge In oHoleRef.Edges
For Each oConnectedFace In oCylEdge.faces
If oConnectedFace.Surfacetype = kConeSurface And oConnectedFace.InternalName <> oEndFace.InternalName Then
bStartIsCone = True
For Each oConicEdge In oConnectedFace.edges
If oConicEdge.Geometry.Radius > oRadConicEdge Then
oRadConicEdge = oConicEdge.Geometry.Radius
oStartConeOuterEdge = oConicEdge
End If
Next
' Bestimmung der Höhe des Eingangskonus
If oConnectedFace.edges.count > 2 Then
Else
oConeCX = oConnectedFace.edges.Item(1).Geometry.center.X - oConnectedFace.edges.Item(2).Geometry.center.X
oConeCY = oConnectedFace.edges.Item(1).Geometry.center.Y - oConnectedFace.edges.Item(2).Geometry.center.Y
oConeCZ = oConnectedFace.edges.Item(1).Geometry.center.Z - oConnectedFace.edges.Item(2).Geometry.center.Z
oConeHight = Sqrt(oConeCX^2 + oConeCY^2 + oConeCZ^2)*10
End If
End If
Next
Next
' wenn der Bohrungsstart konisch ist, muss das auf die Bohrungstiefe aufgerechnet werden
If bStartIsCone = True Then
Bohrungstiefe = Bohrungstiefe + oConeHight
End If
' Ist die Endfläche ein Konus
Dim bEndIsCone As Boolean
If oEndFace.SurfaceType = kConeSurface Then
MaxDepth = Bohrungstiefe + oHoleRef.geometry.radius * 10 / Math.Tan(oEndFace.geometry.HalfAngle)
bEndIsCone = True
Else
MaxDepth = Bohrungstiefe
bEndIsCone = False
End If
' Wenn Endfläche ein Konus ist, wie viele Kanten hat er (bei mehr als 2 ist die Endfläche eine konische Außenfläche und kein Bohrlochgrund
Dim bConeNoHoleTip As Boolean
If bEndIsCone = True And oEndFace.Edges.Count > 2 Then
bConeNoHoleTip = True
Else
bConeNoHoleTip = False
End If
Dim bFlatHoleGround As Boolean
If oEndFace.SurfaceType = kPlaneSurface And oEndFace.Edges.Count = 1 Then
bFlatHoleGround = True
Else
bFlatHoleGround = False
End If
' Skizze erstellen
Dim oSketch As PlanarSketch = Nothing
oSketch = oCompDef.Sketches.Add(oStartFace)
oSketch.Edit
' Bohrungskante in Skizze projezieren
If bStartIsCone = True Then
Call oSketch.AddByProjectingEntity(oStartConeOuterEdge)
Else
If oHoleRef.Edges.Item(1).GeometryType <> kCircleCurve Then
Call oSketch.AddByProjectingEntity(oHoleRef.edges.Item(2))
Else
Call oSketch.AddByProjectingEntity(oHoleRef.edges.Item(1))
End If
End If
oSketch.ExitEdit
' Profil für die Extrusion wählen
Dim oProfile As Profile = Nothing
oProfile = oSketch.Profiles.AddForSolid
' Bohrung verschließen mit einer Extrusion bis zu angewählten Endfläche
Dim oExtrudeDef As ExtrudeDefinition
oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
'Wenn die Grundfläche ein Konus ist wird mit der maximalen Entfernung gerechnet, um die Bohrungstiefe zu erhalten
If bEndIsCone = True And bConeNoHoleTip = False Then
Call oExtrudeDef.SetDistanceExtent(MaxDepth / 10, kNegativeExtentDirection)
Else
Call oExtrudeDef.SetToExtent(oEndFace, kNegativeExtentDirection)
End If
Dim oExtrude As ExtrudeFeature
oExtrude = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
' Extrusion im Featurebaum kenntlich machen
oExtrude.Name = oExtrude.Name & oStrMarker
' Skizzenpunkt in der erstellten Skizze als Zentrum der neuen Bohrung definieren
oSketch.Edit
oHoleCenter1 = ThisApplication.TransientObjects.CreateObjectCollection
Dim oCoord1 As Point2d
oCoord1 = oTransGeom.CreatePoint2d(oSketch.SketchPoints.Item(1).Geometry.X + 5 , oSketch.SketchPoints.Item(1).Geometry.Y + 5)
oSketch.SketchPoints.Add(oCoord1)
oSketch.SketchPoints.Item(2).HoleCenter = True
oSketch.SketchPoints.Item(2).Merge (oSketch.SketchPoints.Item(1))
oHoleCenter1.Add(oSketch.SketchPoints.Item(1))
oSketch.ExitEdit
' Skizze wird verwendet von der Extrusion und der neuen Bohrung
oSketch.Shared = True
' Anhand vom ursprünglichen Bohrungsdurchmesser ein Nennmaß für das Gewinde wählen
Select Case Hole_Dia
Case <= 1.7
Nennmass = "M2x0.4"
Steigung = 0.4
Case <= 2.2
Nennmass = "M2.5x0.45"
Steigung = 0.45
Case <= 2.6
Nennmass = "M3x0.5"
Steigung = 0.5
Case <= 3.4
Nennmass = "M4x0.7"
Steigung = 0.7
Case <= 4.3
Nennmass = "M5x0.8"
Steigung = 0.8
Case <= 5.1
Nennmass = "M6x1"
Steigung = 1
Case <= 7
Nennmass = "M8x1.25"
Steigung = 1.25
Case <= 8.6
Nennmass = "M10x1.5"
Steigung = 1.5
Case <= 10.6
Nennmass = "M12x1.75"
Steigung = 1.75
Case <= 14.1
Nennmass = "M16x2"
Steigung = 2
Case <= 17.6
Nennmass = "M20x2.5"
Steigung = 2.5
Case <= 21.1
Nennmass = "M24x3"
Steigung = 3
Case <= 26.6
Nennmass = "M30x3.5"
Steigung = 3.5
Case <= 32.1
Nennmass = "M36x4"
Steigung = 4
Case <= 37.6
Nennmass = "M42x4.5"
Steigung = 4.5
Case <= 43.1
Nennmass = "M48x5"
Steigung = 5
Case <= 50.6
Nennmass = "M56x5.5"
Steigung = 5.5
Case Else
Nennmass = "M64x6"
Steigung = 6
End Select
' Gewindetiefe festlegen
Gewindetiefe = Bohrungstiefe - 3 * Steigung
If Gewindetiefe <= 0 Then
Gewindetiefe = Bohrungstiefe
End If
' Skizzenpunkt in der erstellten Skizze als Zentrum der neuen Bohrung definieren
oSketch.Edit
oSketch.SketchPoints.Item(1).HoleCenter = True
oSketch.ExitEdit
' Gewindebohrung erstellen
Dim oHoleTapInfo As HoleTapInfo
oHoleTapInfo = ThisApplication.ActiveDocument.ComponentDefinition.Features.HoleFeatures.CreateTapInfo _
(True, "ISO Metrisches Profil", Nennmass, "6H", False, Gewindetiefe / 10)
BottomTipAngle = 140 * PI / 180
If bEndIsCone = True And bConeNoHoleTip = False Then 'wenn Grundlochbohrung mit konischem Bohrungsgrund
oBohrung2 = ThisApplication.ActiveDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByDistanceExtent _
(oHoleCenter1, oHoleTapInfo, Bohrungstiefe / 10, PartFeatureExtentDirectionEnum.kPositiveExtentDirection, False, BottomTipAngle)
Else If bEndIsCone = True And bConeNoHoleTip = True Then 'Wenn Durchgangsbohrung mit konischer Endfläche
oBohrung2 = ThisApplication.ActiveDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByThroughAllExtent _
(oHoleCenter1, oHoleTapInfo, PartFeatureExtentDirectionEnum.kPositiveExtentDirection)
Else If bFlatHoleGround = True Then 'wenn Grundlochbohrung mit flachem Bohrlochgrund
oBohrung2 = ThisApplication.ActiveDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByDistanceExtent _
(oHoleCenter1, oHoleTapInfo, Bohrungstiefe/10, PartFeatureExtentDirectionEnum.kPositiveExtentDirection, False, BottomTipAngle)
Else 'Wenn Durchgangsbohrung und Endfläche ist Ebene (parallel oder nicht)
oBohrung2 = ThisApplication.ActiveDocument.ComponentDefinition.Features.HoleFeatures.AddDrilledByToFaceExtent _
(oHoleCenter1, oHoleTapInfo, oEndFace, True)
End If
' hat die Bohrung eine Eingangsfase, wird diese wieder hergestellt
If bStartIsCone = True Then
oBohrung2.SetCSink(oRadConicEdge*2,90*(PI/180) )
End If
' Extrusion im Featurebaum kenntlich machen
oBohrung2.name = oBohrung2.Name & oStrMarker
' Sichtbarkeit der Skizze deaktivieren
oSketch.Visible = False
' Wenn erfolgreich, dann beginne wieder am Start mit der nächsten Bohrung
GoTo TheStart :
End If
Return
ENDE :
Rule - 2 - make an "irregular pattern" with all equal holes
' Makro um die mit der iLogic "Autobohrung_Bohrung_ersetzen_mit_metrischer_Gewindebohrung" erzeugten Extrusionen und Bohrungen beliebig anzuordnen
' vergleichbar mit dem Skizzenmuster, allerdings werden die gemusterten Gewinde dann nicht im Kalkulationsprogramm Classmate erkannt
TheStart:
Dim oDoc As Document
oDoc = ThisApplication.ActiveDocument
Dim oEdDoc As Document
oEdDoc = ThisApplication.ActiveEditDocument
'If Not ThisApplication.ActiveDocument.DocumentType = kPartDocumentObject Then
' MessageBox.Show("Funktioniert nur in Einzelteilen.", "iLogic")
' Return
'Else
'End If
On Error GoTo ENDE
If oDoc.DocumentType = kassemblyDocumentobject And Not oEdDoc.DocumentType = kpartdocumentobject Then
Dim Auswahl As Integer
Dim Message As String
Message = "Bohrung ersetzen ist nur in Einzelteilen möglich." & vbLf & vbLf & "Soll ein Einzelteil gewählt und die Bearbeitung wiederholt werden?"
Auswahl = MessageBox.Show(Message, "Achtung!", MessageBoxButtons.OKCancel)
If Auswahl = 1 Then
Dim oOcc As ComponentOccurrence
oOcc = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter , "Wähle eine Baugruppenkomponente aus.")
oOcc.Edit
GoTo TheStart
Else
GoTo Ende
End If
Else If oDoc.DocumentType = kAssemblyDocumentObject And oEdDoc.DocumentType = kPartDocumentObject Then
Dim oDocDef As AssemblyComponentDefinition = oDoc.ComponentDefinition
Dim oOccs As ComponentOccurrences = oDocDef.Occurrences
Dim oSourceOcc As ComponentOccurrence
For Each oSourceOcc In oOccs
If oSourceOcc.Definition.Document.InternalName = oEdDoc.InternalName Then
Exit For
Else
GoTo Ende
End If
Next
Dim oDestinationOcc As ComponentOccurrence
oDestinationOcc = oOccs.ItemByName(oSourceOcc.Name)
Dim oDestinationDef As PartComponentDefinition = oDestinationOcc.Definition
' oDestinationOcc = oSourceOcc
oDoc = oEdDoc
' Definition der transienten Geometrie
Dim oTransGeom As TransientGeometry
oTransGeom = ThisApplication.TransientGeometry
' referenzieren der Komponenten Definition
Dim oCompDef As PartComponentDefinition
oCompDef = oDoc.ComponentDefinition
' Nutzer muss die Bohrung im Featurebaum wählen
Dim oDrillHole As HoleFeature
oDrillHole = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFeatureFilter, "Gewindebohrung wählen")
' die Skizze der Bohrung wird editiert
Dim oSketch As PlanarSketch = Nothing
Dim oSketchProxy As PlanarSketchProxy = Nothing
'' oSketch = oDrillHole.Sketch
For Each oSketch In oDestinationOcc.Definition.Sketches
If oSketch.Name = oDrillHole.Sketch.Name Then Exit For
Next
'' oSketch.Edit
Dim oProfile As Profile
' in der Skizze wird geprüft welche Features sie noch referenziert haben und die Extrusion zum Verschließen der Ursprungsbohrung wird gesucht
Dim i As Integer
Dim oExtrusion As ExtrudeFeature
For i = 1 To oSketch.Dependents.Count
If oSketch.Dependents.Item(i).Type = kExtrudeFeatureObject Then
oExtrusion = oSketch.Dependents.Item(i)
Exit For
End If
i = i + 1
Next
' Bohrungskanten in Skizze projezieren
Dim oSourceFace As Face
Dim oSourceEdge As Edge
Dim oSourceEdgeProxy As EdgeProxy
Dim oDestinationFace As Face
Dim oDestinationFaceProxy As FaceProxy = Nothing
' Wenn es weitere Flächen in der gleichen Ebene gibt, kann es zu Problemen führen und es werden nicht alle Bohrungskanten gefunden.
' Deshalb werden alle Flächen geprüft
For Each oSourceFace In oSketch.PlanarEntity.Parent.Faces
If oSourceFace.InternalName = oSketch.PlanarEntity.InternalName Then
For Each oDestinationFace In oSketch.PlanarEntity.Parent.Faces
If oDestinationFace.InternalName = oSketch.PlanarEntity.InternalName Then
For Each oSourceEdge In oSourceFace.Edges
If oSourceEdge.CurveType = kCircleCurve Then
' Nur Bohrungen projizieren, die im Grenzbereich den gleichen Durchmesser(Radius) haben
If oSourceEdge.Geometry.Radius < oSketch.SketchCircles.Item(1).Radius * 1.001 And _
oSourceEdge.Geometry.Radius > oSketch.SketchCircles.Item(1).Radius * 0.999 Then
Dim bXCoinci As Boolean
bXCoinci = True
Dim bYCoinci As Boolean
bYCoinci = True
Dim bZCoinci As Boolean
bZCoinci = True
' Vergleich ob vorhandener Kreis gefunden wurde, bei negativen Koordinaten muss auch der Vergleich umgedreht werden
If oSketch.SketchCircles.Item(1).Geometry3d.Center.X >=0 Then
If oSourceEdge.Geometry.Center.X <= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 1.001 And _
oSourceEdge.Geometry.Center.X >= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 0.999 Then
bXCoinci = True
Else
bXCoinci = False
End If
Else
If oSourceEdge.Geometry.Center.X >= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 1.001 And _
oSourceEdge.Geometry.Center.X <= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 0.999 Then
bXCoinci = True
Else
bXCoinci = False
End If
End If
If oSketch.SketchCircles.Item(1).Geometry3d.Center.Y >=0 Then
If oSourceEdge.Geometry.Center.Y <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 1.001 And _
oSourceEdge.Geometry.Center.Y >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 0.999 Then
bYCoinci = True
Else
bYCoinci = False
End If
Else
If oSourceEdge.Geometry.Center.Y >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 1.001 And _
oSourceEdge.Geometry.Center.Y <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 0.999 Then
bYCoinci = True
Else
bYCoinci = False
End If
End If
If oSketch.SketchCircles.Item(1).Geometry3d.Center.Z >=0 Then
If oSourceEdge.Geometry.Center.Z <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 1.001 And _
oSourceEdge.Geometry.Center.Z >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 0.999 Then
bZCoinci = True
Else
bZCoinci = False
End If
Else
If oSourceEdge.Geometry.Center.Z >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 1.001 And _
oSourceEdge.Geometry.Center.Z <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 0.999 Then
bZCoinci = True
Else
bZCoinci = False
End If
End If
' Projezieren des Kreises in Skizze, wenn nicht schon vorhanden
If bXCoinci = True And _
bYCoinci = True And _
bZCoinci = True Then
Else
'###### here must be the Problem #####
Dim oSketchCircleNew As SketchCircle
oSourceOcc.CreateGeometryProxy(oSourceEdge, oSourceEdgeProxy)
oDestinationOcc.CreateGeometryProxy(oDestinationFace, oDestinationFaceProxy)
oDestinationOcc.Edit
oDestinationOcc.CreateGeometryProxy(oSketch, oSketchProxy)
''das sollte bleiben
oSketchCircleNew = oSketchProxy.AddByProjectingEntity(oSourceEdgeProxy)
'###### here must be the Problem #####
End If
End If
End If
Next
End If
Next
End If
Next
' Erstellen einer Object Collection für die Kreise
Dim oPathSegments As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Dim oCircle As SketchCircle
For Each oCircle In oSketch.SketchCircles
oPathSegments.Add(oCircle)
oCircle.CenterSketchPoint.HoleCenter = True
Next
' Hinzufügen von Bohrungsmittelpunkten zu den projezierten Kreisen
Dim oHolecenter1 As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Dim oPoint As SketchPoint
For Each oPoint In oSketch.SketchPoints
If oPoint.HoleCenter = True Then
oHolecenter1.Add (oPoint)
End If
Next
' Hinzufügen der projezierten Kreise zu den Profilen
oProfile = oSketch.Profiles.AddForSolid(False, oPathSegments)
oSketch.Solve
oSketch.ExitEdit
' Extrusion aller Profile
oExtrusion.Definition.Profile = oProfile
' Bohrung ausführen
oDrillHole.HoleCenterPoints = oHolecenter1
Else If ThisApplication.ActiveDocument.Documenttype = kpartdocumentobject Then
' Definition der transienten Geometrie
Dim oTransGeom As TransientGeometry
oTransGeom = ThisApplication.TransientGeometry
' referenzieren der Komponenten Definition
Dim oCompDef As PartComponentDefinition
oCompDef = oDoc.ComponentDefinition
' Nutzer muss die Bohrung im Featurebaum wählen
Dim oDrillHole As HoleFeature
oDrillHole = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFeatureFilter, "Gewindebohrung wählen")
' die Skizze der Bohrung wird editiert
Dim oSketch As PlanarSketch = Nothing
oSketch = oDrillHole.Sketch
oSketch.Edit
Dim oProfile As Profile
' in der Skizze wird geprüft welche Features sie noch referenziert haben und die Extrusion zum Verschließen der Ursprungsbohrung wird gesucht
Dim i As Integer
Dim oExtrusion As ExtrudeFeature
For i = 1 To oSketch.Dependents.Count
If oSketch.Dependents.Item(i).Type = kExtrudeFeatureObject Then
oExtrusion = oSketch.Dependents.Item(i)
Exit For
End If
i = i + 1
Next
' Bohrungskanten in Skizze projezieren
Dim oEdge As Object
Dim oFace As Object
' Wenn es weitere Flächen in der gleichen Ebene gibt, kann es zu Problemen führen und es werden nicht alle Bohrungskanten gefunden.
' Deshalb werden alle Flächen geprüft
For Each oFace In oSketch.PlanarEntity.Parent.Faces
If oFace.InternalName = oSketch.PlanarEntity.InternalName Then
For Each oEdge In oFace.Edges
If oEdge.CurveType = kCircleCurve Then
' Nur Bohrungen projezieren, die im Grenzbereich den gleichen Durchmesser(Radius) haben
If oEdge.Geometry.Radius < oSketch.SketchCircles.Item(1).Radius * 1.001 And _
oEdge.Geometry.Radius > oSketch.SketchCircles.Item(1).Radius * 0.999 Then
Dim bXCoinci As Boolean
bXCoinci = True
Dim bYCoinci As Boolean
bYCoinci = True
Dim bZCoinci As Boolean
bZCoinci = True
' Vergleich ob vorhandener Kreis gefunden wurde, bei negativen Koordinaten muss auch der Vergleich umgedreht werden
If oSketch.SketchCircles.Item(1).Geometry3d.Center.X >=0 Then
If oEdge.Geometry.Center.X <= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 1.001 And _
oEdge.Geometry.Center.X >= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 0.999 Then
bXCoinci = True
Else
bXCoinci = False
End If
Else
If oEdge.Geometry.Center.X >= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 1.001 And _
oEdge.Geometry.Center.X <= oSketch.SketchCircles.Item(1).Geometry3d.Center.X * 0.999 Then
bXCoinci = True
Else
bXCoinci = False
End If
End If
If oSketch.SketchCircles.Item(1).Geometry3d.Center.Y >=0 Then
If oEdge.Geometry.Center.Y <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 1.001 And _
oEdge.Geometry.Center.Y >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 0.999 Then
bYCoinci = True
Else
bYCoinci = False
End If
Else
If oEdge.Geometry.Center.Y >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 1.001 And _
oEdge.Geometry.Center.Y <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Y * 0.999 Then
bYCoinci = True
Else
bYCoinci = False
End If
End If
If oSketch.SketchCircles.Item(1).Geometry3d.Center.Z >=0 Then
If oEdge.Geometry.Center.Z <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 1.001 And _
oEdge.Geometry.Center.Z >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 0.999 Then
bZCoinci = True
Else
bZCoinci = False
End If
Else
If oEdge.Geometry.Center.Z >= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 1.001 And _
oEdge.Geometry.Center.Z <= oSketch.SketchCircles.Item(1).Geometry3d.Center.Z * 0.999 Then
bZCoinci = True
Else
bZCoinci = False
End If
End If
' Projezieren des Kreises in Skizze, wenn nicht schon vorhanden
If bXCoinci = True And _
bYCoinci = True And _
bZCoinci = True Then
Else
Call oSketch.AddByProjectingEntity(oEdge)
End If
End If
End If
Next
End If
Next
' Erstellen einer Object Collection für die Kreise
Dim oPathSegments As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Dim oCircle As SketchCircle
For Each oCircle In oSketch.SketchCircles
oPathSegments.Add(oCircle)
oCircle.CenterSketchPoint.HoleCenter = True
Next
' Hinzufügen von Bohrungsmittelpunkten zu den projezierten Kreisen
Dim oHolecenter1 As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Dim oPoint As SketchPoint
For Each oPoint In oSketch.SketchPoints
If oPoint.HoleCenter = True Then
oHolecenter1.Add (oPoint)
End If
Next
' Hinzufügen der projezierten Kreise zu den Profilen
oProfile = oSketch.Profiles.AddForSolid(False, oPathSegments)
oSketch.Solve
oSketch.ExitEdit
' Extrusion aller Profile
oExtrusion.Definition.Profile = oProfile
' Bohrung ausführen
oDrillHole.HoleCenterPoints = oHolecenter1
End If
Ende:
Thanks for your help 🙂.