Message 1 of 3
Ilogic - projecting the hole onto the surface instead of standard adaptive
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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 ??