Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Issues with Proxys in Assembly

Michael.RostZ454J
Contributor

Issues with Proxys in Assembly

Michael.RostZ454J
Contributor
Contributor

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 🙂.

0 Likes
Reply
175 Views
0 Replies
Replies (0)