Trying to add hole centers from horizontal frame members to verticals
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Good morning;
I am trying to place workpoints on to frame members based on locations of screw splines of the horizontal frame members. I wrote a rule that creates a workaxis at a cylindrical face of filtered size, that mostly works ( I tried to name each workaxis, but that fails, and is not part of current problem I'm inquiring about)
I attached a jpg of an experimental frame, the frame I intend to use it on is much more complex.
I've tried different objects, parameters, just can't see which way to go . Any suggestions or better process would be most appreciated, thank you in advance.
<code>
Sub Main
' Get the active assembly.
Dim oAssyDoc As AssemblyDocument = ThisApplication.ActiveDocument
'On Error Resume Next
'MessageBox.Show(oAssyDoc.FullDocumentName, "Title")
Call TraverseAssembly(oAssyDoc.ComponentDefinition.Occurrences)
End Sub
Sub TraverseAssembly(ByRef oOccs As ComponentOccurrences)
' Iterate through all of the occurrence in this collection
Dim oOcc As ComponentOccurrence
' On Error Resume Next
For Each oOcc In oOccs
If oOcc.DefinitionDocumentType = Inventor.DocumentTypeEnum.kAssemblyDocumentObject Then
'' Recursively Call Sub If needed
Call TraverseAssembly(oOcc.SubOccurrences)
Else If oOcc.Definition.Document.propertysets.item("Design Tracking Properties").item("Stock Number").VALUE = "Horizontal" Then
'oOcc.DefinitionDocumentType = Inventor.DocumentTypeEnum.kPartDocumentObject And oOcc.SurfaceBodies.Count >0 Then
CreateHoles(oOcc.Definition.SurfaceBodies(1))
End If
Next
End Sub
Sub CreateHoles(ByVal SrfcBd As Inventor.SurfaceBody)
Dim PrtCmp As Inventor.PartComponentDefinition
PrtCmp = SrfcBd.Parent
Dim oAxis As Dictionary(Of Object, Object)
Dim oAxs As Inventor.WorkAxis
Dim oNrml As Inventor.UnitVector
Dim oNrmlRev As Inventor.UnitVector
Dim ZLength As Double
Dim sktch As PlanarSketch
Dim oPln As Object
Dim CNTRD As Object
Dim EndFc As Inventor.Face
Dim StrtFc As Inventor.Face
Dim oTG As TransientGeometry
Dim Indx As Long
Dim CntrPt As Inventor.Point= PrtCmp.MassProperties.CenterOfMass
oTG = ThisApplication.TransientGeometry
oAxis = New Dictionary(Of Object, Object)
Call GetAxes(PrtCmp, oAxis)
sktch = PrtCmp.Features.ExtrudeFeatures(1).Definition.Profile(1)(1).SketchEntity.Parent
oPln = sktch.PlanarEntity
EndFc = PrtCmp.Features.ExtrudeFeatures(1).Faces.Item(PrtCmp.Features.ExtrudeFeatures(1).Faces.Count)
StrtFc = PrtCmp.Features.ExtrudeFeatures(1).Faces.Item(PrtCmp.Features.ExtrudeFeatures(1).Faces.Count - 1)
Dim repStrt As Inventor.Plane
Dim repEnd As Inventor.Plane
Dim EndPl = PrtCmp.WorkPlanes("End Plane")
Dim StrtPl = PrtCmp.WorkPlanes("Start Plane")
repStrt = oTG.CreatePlane(CntrPt,StrtPl.Plane.Normal.AsVector)
repEnd = oTG.CreatePlane(CntrPt,EndPl.Plane.Normal.AsVector)
Dim intPoints As ObjectsEnumerator
Dim intPoint As Point
Dim Jndx As Long
Dim foundEnts As ObjectsEnumerator
Dim locPoints As ObjectsEnumerator
Dim resultPoints As ObjectCollection
resultPoints = ThisApplication.TransientObjects.CreateObjectCollection
''Jndx triggers start plane or end plane of the frame generator part, hopefully
For Jndx = 0 To 1
Dim skNormal As UnitVector
skNormal = IIf (Jndx<1, StrtPl.Plane.Normal, EndPl.Plane.Normal)
Dim proxVector As Object
Dim proxPoint As Object
Dim msg As String
msg = CntrPt.X & ", " & CntrPt.Y & ", " & CntrPt.Z & vbCrLf & StrtPl.Plane.Normal.X & ", " & StrtPl.Plane.Normal.Y & ", " & StrtPl.Plane.Normal.Z _
& vbCrLf & EndPl.Plane.Normal.X & ", " & EndPl.Plane.Normal.Y & ", " & EndPl.Plane.Normal.Z
MessageBox.Show(msg, "Title")
MessageBox.Show(PrtCmp.Document.displayname,"Using")
''added calls to get a proxy for the center point and vectors hoping to get to find something at the foundEnts below
'' get error parameter incorrect
Call ThisApplication.ActiveDocument.ComponentDefinition.Occurrences.ItemByName(PrtCmp.Document.displayname).CreateGeometryProxy(CntrPt, proxPoint)
Call ThisApplication.ActiveDocument.ComponentDefinition.Occurrences.ItemByName(PrtCmp.Document.displayname).CreateGeometryProxy(skNormal, proxVector)
Dim TrgtFound As ObjectsEnumerator = ThisApplication.ActiveDocument.ComponentDefinition.FindUsingVector(proxPoint, _
proxVector, {SelectionFilterEnum.kAllEntitiesFilter })
' Call PrtCmp.FindUsingRay(CntrPt, IIf(Jndx=0,StrtPl,EndPl), 0.01, TrgtFound, locPoints, False)
For Indx = 1 To oAxis.Keys.Count
intPoints = oAxis.Item(Indx).line.IntersectWithSurface(IIf (Jndx<1, repStrt, repEnd))
intPoint = intPoints(1)
MessageBox.Show(trgtfound.Count, "Title")
Call trgtfound(1).definition.FindUsingRay(intPoint, skNormal, 0.00001, foundEnts, locPoints, True)
'' tried different things with different errors, as is, the error is that nothing was found.
' If an intersection was found, add it to the list.
MessageBox.Show("Message", "Title")
If locPoints.Count > 0 Then
''If foundEnts(1).type = ObjectTypeEnum.kFaceProxyObject Then
Dim wp As WorkPoint = trgtfound(1).definition.workpoints.addfixed(locpoints(1))
wp.Name = "WP_" & Left(PrtCmp.Document.fullfilename,Len(PrtCmp.Document.fullfilename)-4) & Indx
''End If
End If
Next 'Indx
Next 'Jndx
End Sub
Sub GetAxes(ByVal PrtComp As Inventor.PartComponentDefinition, ByRef oAxis As Dictionary(Of Object, Object))
Dim oAxs As Inventor.WorkAxis
Dim Indx As Long
If PrtComp.WorkAxes.Count >3 Then
Indx = 0
For Each oAxs In PrtComp.WorkAxes
If oAxs.IsCoordinateSystemElement = False Then
Indx = Indx + 1
oAxis.ADD(Indx, oAxs)
End If
Next
End If
End Sub
<\code>
