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

Ilogic - projecting the hole onto the surface instead of standard adaptive

Hello,

 

I am asking for help in improving my rule that I use to project holes. I use it as in the attached video:


 

	'sprawdzanie czy jesteśmy w złożeniu
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
		MsgBox("REGULA DZIAŁA TYLKO W ZESPOLE", vbCritical, "OSTRZEŻENIE")
		Exit Sub
End If

Dim oAsm As AssemblyDocument = ThisDoc.Document
Dim oTransaction As Transaction = ThisApplication.TransactionManager.StartTransaction(oAsm, "RZUTOWANIE OTWORÓW")
Dim oFace As FaceProxy
'obsluga bledu jezeli ktoś sie rozmysli przy wybieraniu plaszczyzny z otworami
While True
   oFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "WSKAŻ PŁASZCZYZNE Z OTWORAMI")
	' jesli nic nie wybrane to	
	If IsNothing(oFace) Then GoTo koniec Else
		Exit While
End While

Dim oFaceOcc As ComponentOccurrence = oFace.ContainingOccurrence

Dim aFace As FaceProxy

'obsluga bledu jezeli ktoś sie rozmysli przy wybieraniu plaszczyzny rzutowania
While True
   aFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "WSKAŻ PŁASZCZYZNE RZUTOWANIA")
	
	' jesli nic nie wybrane to 	
	If IsNothing(aFace) Then goto koniec Else
		Exit While
End While

Dim aFaceRefKey(-1) As Byte
Dim aFaceKeyContext As Integer = oAsm.ReferenceKeyManager.CreateKeyContext
aFace.GetReferenceKey(aFaceRefKey, aFaceKeyContext)
Dim aOcc As ComponentOccurrence = aFace.ContainingOccurrence
Dim aDef As PartComponentDefinition = aOcc.Definition
Dim NPBFdef As NonParametricBaseFeatureDefinition = aDef.Features.NonParametricBaseFeatures.CreateDefinition
Dim oCol As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
oCol.Add(oFace)
NPBFdef.BRepEntities = oCol
NPBFdef.OutputType = kSurfaceOutputType
NPBFdef.TargetOccurrence = aOcc
NPBFdef.IsAssociative = True

'sprawdzanie czy nie ma użytego pogrubienia lub edycji bezpośredniej
If aDef.Features.ThickenFeatures.Count > 0 Or aDef.Features.DirectEditFeatures.Count >0 Then
	MsgBox("W CZĘŚCI NA KTÓRĄ RZUTUJESZ JEST POGRUBIENIE LUB EDYCJA BEZPOŚREDNIA - USUN TO", vbCritical, "OSTRZEŻENIE")
	goto koniec
	Exit Sub
Else
End If

Dim planeInput As New List(Of KeyValuePair(Of WorkPoint, WorkAxis))

Dim cpySurf As NonParametricBaseFeature
cpySurf = aDef.Features.NonParametricBaseFeatures.AddByDefinition(NPBFdef)
For Each oLoop As EdgeLoop In cpySurf.Faces(1).EdgeLoops
	If oLoop.IsOuterEdgeLoop = False
		Dim oPoint As WorkPoint = aDef.WorkPoints.AddAtCentroid(oLoop)
		Dim oAxis As WorkAxis = aDef.WorkAxes.AddByNormalToSurface(oAsm.ReferenceKeyManager.BindKeyToObject(aFaceRefKey, aFaceKeyContext).NativeObject, oPoint)
		planeInput.Add(New KeyValuePair(Of WorkPoint, WorkAxis)(oPoint, oAxis))
	End If
Next
cpySurf.SurfaceBodies(1).Visible = False


    Dim oPlaszczyzna As WorkPlane = aDef.WorkPlanes.AddByPlaneAndOffset(oAsm.ReferenceKeyManager.BindKeyToObject(aFaceRefKey, aFaceKeyContext).NativeObject, 0)
	oPlaszczyzna.Visible = False
	Dim oSketch As PlanarSketch = aDef.Sketches.Add(oPlaszczyzna)
	oSketch.Visible = True
	
For Each oPair As KeyValuePair(Of WorkPoint, WorkAxis) In planeInput
	Dim oCP As SketchPoint = oSketch.AddByProjectingEntity(oPair.Key)
	Dim oEP As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(oCP.Geometry.X + 1 / 2, oCP.Geometry.Y)
	Dim oSlot As SketchEntitiesEnumerator = oSketch.AddStraightSlotBySlotCenter(oCP, oEP, 0.9)
	Dim oLine As SketchLine = oSlot.OfType(Of SketchLine).FirstOrDefault(Function(x As SketchLine) x.Construction = True)
'	oSketch.GeometricConstraints.AddHorizontal(oLine)
	oSketch.DimensionConstraints.AddTwoPointDistance(oLine.StartSketchPoint, oLine.EndSketchPoint, DimensionOrientationEnum.kHorizontalDim, oCP.Geometry)
	Dim oLines = oSlot.OfType(Of SketchLine).Where(Function(x As SketchLine) x.Construction = False)
	Dim oLine1 As SketchLine = oLines(0)
	Dim oLine2 As SketchLine = oLines(1)
	oSketch.DimensionConstraints.AddOffset(oLine1, oLine2, oCP.Geometry, False)
'	Dim oProfile As Profile = oSketch.Profiles.AddForSolid
'	aDef.Features.EmbossFeatures.AddEngraveFromFace(oProfile, 2, PartFeatureExtentDirectionEnum.kNegativeExtentDirection, , oAsm.ReferenceKeyManager.BindKeyToObject(aFaceRefKey, aFaceKeyContext).NativeObject)
	
	oSketch.DimensionsVisible=False
	oPair.Key.Visible = False
	oPair.Value.Visible = False
Next

koniec:
oAsm.Update
oTransaction.End
InventorVb.DocumentUpdate() 

'Wyłaczenie adaptacyjnosci
iLogicVb.Automation.RunExternalRule(oAsm, "ADAPTACJA_OFF")

 

I have some ideas for improvement but I don't know how to carry them out.

I would need:
1. be able to project holes from several planes so that they are in one sketch on the projection plane.
2. measure the projected diameters and on this basis insert the appropriate holes (example: measured diameter = 6.448mm new hole = 9mm)

 

Someone help me ??