Message 1 of 9
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
I try to make a work point pattern using the originally selected sketch. The pattern should be placed between the start and end point and the points should be 3000 mm apart. Here is the program I already have. With this program I can select the surface on which I will make a sketch and all the edges I wont to project. Is there anyone who can help me with point pattern?
Dim oPart As PartDocument = ThisApplication.ActiveDocument Dim oDef As PartComponentDefinition = oPart.ComponentDefinition Dim oFace As Inventor.Face SelectFace : oFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Select Face to Place Sketch") If oFace Is Nothing Then MsgBox("No face was selected. Exiting.",,"") Exit Sub ElseIf oFace.SurfaceType <> SurfaceTypeEnum.kPlaneSurface Then MsgBox("Selected face was not planar. Please select planar (flat) face.", , "") GoTo SelectFace End If Dim oSketch As PlanarSketch = oDef.Sketches.Add(oFace, False) Dim oTO As TransientObjects = ThisApplication.TransientObjects Dim oEdges As ObjectCollection = oTO.CreateObjectCollection Dim oPoints As ObjectCollection = oTO.CreateObjectCollection Dim oEdge As Edge Dim oPoint As Inventor.Point Do oEdge = ThisApplication.CommandManager.Pick( _ SelectionFilterEnum.kPartEdgeFilter, "Select a edge") ' If nothing gets selected then we're done If oEdge IsNot Nothing Then oEdges.Add(oEdge) Else Exit Do End If Dim oSE As SketchEntity = oSketch.AddByProjectingEntity(oEdge) If TypeOf oSE Is SketchLine Then Dim oSL As SketchLine = oSE oPoints.Add(oSL.StartSketchPoint.Geometry3d) oPoints.Add(oSL.EndSketchPoint.Geometry3d) ElseIf TypeOf oSE Is SketchArc Then Dim oSA As SketchArc = oSE oPoints.Add(oSA.StartSketchPoint.Geometry3d) oPoints.Add(oSA.EndSketchPoint.Geometry3d) End If MsgBox("oEdges.Count = " & oEdges.Count & vbCrLf & _ "oPoints.Count = " & oPoints.Count,,"") Loop Until oEdge Is Nothing For Each oPoint In oPoints Dim oDuplicate As Boolean = False Dim oWP As WorkPoint = Nothing For Each oWP In oDef.WorkPoints If oWP.Point.X = oPoint.X And _ oWP.Point.Y = oPoint.Y And _ oWP.Point.Z = oPoint.Z Then oDuplicate = True End If Next If oDuplicate = False Then oWP = oDef.WorkPoints.AddFixed(oPoint, False) End If Next
Solved! Go to Solution.