I am trying to create a workplane by a point and a line. I can do this maually, but have not been able to reproduce this in code.
Does anyone know how I can do this?
BTW: I realize I can create a fixed workplane by using the point, the edge, and an edge perpendicular to the edge, but I cannot have this as a fixed workplane.
Solved! Go to Solution.
Solved by adam.nagy. Go to Solution.
Hi Farren,
Not sure how far you got with your investigation so I just write down what I checked.
If I created a Work Plane through the UI as you pointed out and then checked in VBA the WorkPlane.Defintion property then I could see that it was NormalToCurveWorkPlaneDef, so I would need to use the WorkPlanes.AddByNormalToCurve function.
If the mid point of the edge is selected then the Definition's Point property is not set, whereas if the start or end point is set then that property is set to the appropriate Vertex of the edge.
I could do the latter but not the mid point version:
Sub AddWorkplane() Dim doc As PartDocument Set doc = ThisApplication.ActiveDocument ' Select an edge and run this code Dim e As Edge Set e = doc.SelectSet(1) Dim wp As WorkPlane ' This succeeds Set wp = doc.ComponentDefinition.WorkPlanes.AddByNormalToCurve(e, e.StartVertex) ' This does not work :( Set wp = doc.ComponentDefinition.WorkPlanes.AddByNormalToCurve(e, Nothing) End Sub
I checked with others and it does not seem possible at the moment. Sorry 😞
I'm logging this in our system.
Cheers,
Hi Farren,
It does not seem to be able to create a WorkPlane using the MidPoint directly.
I think WorkPlane could be created if they create a WorkPoint.
Public Sub Test2() Dim doc As PartDocument Set doc = ThisApplication.ActiveDocument ' Select an edge and run this code Dim e As Edge Set e = doc.SelectSet(1) Dim wp As WorkPlane ' This succeeds ' Set wp = doc.ComponentDefinition.WorkPlanes.AddByNormalToCurve(e, e.StartVertex) ' This does not work :( ' Set wp = doc.ComponentDefinition.WorkPlanes.AddByNormalToCurve(e, Nothing) Dim oWkPoint As WorkPoint Set oWkPoint = doc.ComponentDefinition.WorkPoints.AddFixed(e.Geometry.MidPoint) Set wp = doc.ComponentDefinition.WorkPlanes.AddByNormalToCurve(e, oWkPoint) End Sub
So, it is the following, if any point on the edge.
>>>>>>>>>>>>>>>>>>>>>>>>>>> Option Explicit Public Sub SelectForEdgePoint() Dim oSelect As New clsSelect Dim doc As PartDocument Set doc = ThisApplication.ActiveDocument If doc Is Nothing Then MsgBox "Plese Open the Partfile" Exit Sub End If Dim e As Edge Dim oPoint As Point Call oSelect.StartSelection(e, oPoint) Dim wp As WorkPlane Dim oWkPoint As WorkPoint Set oWkPoint = doc.ComponentDefinition.WorkPoints.AddFixed(oPoint) Set wp = doc.ComponentDefinition.WorkPlanes.AddByNormalToCurve(e, oWkPoint) End Sub >>>>>>>>>>>>>>>>>>>>>>>>>>> >>>> Class module Begin >>>> Private WithEvents oInteraction As InteractionEvents Private WithEvents oSelect As SelectEvents Private bStillSelecting As Boolean Public oPt As Point Public oObj As Edge Public Sub StartSelection(ByRef oEdge As Edge, ByRef oPoint As Point) bStillSelecting = True Set oInteraction = ThisApplication.CommandManager.CreateInteractionEvents Set oSelect = oInteraction.SelectEvents oSelect.AddSelectionFilter kPartEdgeFilter oSelect.SingleSelectEnabled = True oInteraction.Start Do While bStillSelecting ThisApplication.UserInterfaceManager.DoEvents Loop oInteraction.Stop Set oSelectEvents = Nothing Set oInteractEvents = Nothing Set oEdge = oObj Set oPoint = oPt End Sub Private Sub oSelect_OnSelect(ByVal JustSelectedEntities As ObjectsEnumerator, _ ByVal SelectionDevice As SelectionDeviceEnum, ByVal ModelPosition As Point, _ ByVal ViewPosition As Point2d, ByVal View As View) bStillSelecting = False Set oObj = JustSelectedEntities.Item(1) Set oPt = ModelPosition End Sub >>>> Class module End >>>>
Hi Farren
It can be dragging the WorkPoint using UserInputEvents.OnDrag.
You are able to use the "OnDrag Event - dragging a WorkPoint API Sample" sample of the API reference (admapi_17_0.chm).
The sample will be dragging anywhere in three-dimensional space.
Therefore, if you want the point that move on the edge , you can use together SelectEvents.OnPreSelectMouseMove.
The following is a sample with additional modification.
Option Explicit Public oDragWorkPoint As clsDragWorkPoint Sub WorkPointDrag() Set oDragWorkPoint = New clsDragWorkPoint oDragWorkPoint.Initialize ' Stop the command ThisApplication.CommandManager.StopActiveCommand End Sub
Option Explicit Private WithEvents oUserInputEvents As UserInputEvents Private oIE As InteractionEvents Private WithEvents oMouseEvents As MouseEvents Private oIntGraphics As InteractionGraphics Private oWP As WorkPoint '--- Add Begin ---- Private WithEvents oSelect As SelectEvents Dim oModelPoint As Point '--- Add End ---- Dim bGettingPoint As Boolean Dim oPnt As Point Public Sub Initialize() Set oUserInputEvents = ThisApplication.CommandManager.UserInputEvents ' Set oUserInputEvents = ThisApplication.CommandManager.MouseEvents End Sub '--- Add Begin ---- Private Sub oSelect_OnPreSelectMouseMove(ByVal PreSelectEntity As Object, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View) Set oModelPoint = ModelPosition End Sub '--- Add End ---- Private Sub oUserInputEvents_OnActivateCommand(ByVal CommandName As String, ByVal Context As NameValueMap) ' MsgBox "OnActivateCommand" End Sub Private Sub oUserInputEvents_OnContextMenu(ByVal SelectionDevice As SelectionDeviceEnum, ByVal AdditionalInfo As NameValueMap, ByVal CommandBar As CommandBar) 'MsgBox "OnContextMenu" End Sub Private Sub oUserInputEvents_OnDrag( _ ByVal DragState As Inventor.DragStateEnum, _ ByVal ShiftKeys As Inventor.ShiftStateEnum, _ ByVal ModelPosition As Inventor.Point, _ ByVal ViewPosition As Inventor.Point2d, _ ByVal View As Inventor.View, _ ByVal AdditionalInfo As Inventor.NameValueMap, _ HandlingCode As Inventor.HandlingCodeEnum) Dim oSS As SelectSet Set oSS = ThisApplication.ActiveDocument.SelectSet ' MsgBox "oUserInputEvents_OnDrag" & "HandlingCode : " & HandlingCode If DragState = kDragStateDragHandlerSelection Then If oSS.Count = 1 And oSS.Item(1).Type = kWorkPointObject Then Set oWP = oSS.Item(1) If oWP.DefinitionType = kFixedWorkPoint Then HandlingCode = kEventCanceled Set oIE = ThisApplication.CommandManager.CreateInteractionEvents Set oMouseEvents = oIE.MouseEvents oMouseEvents.MouseMoveEnabled = True Set oIntGraphics = oIE.InteractionGraphics Call oIE.SetCursor(kCursorBuiltInCommonSketchDrag) '--- Add Begin ---- Set oSelect = oIE.SelectEvents oSelect.AddSelectionFilter kPartEdgeFilter oSelect.SingleSelectEnabled = True '--- Add End ---- oIE.Start End If End If ' HandlingCode = kEventNotHandled HandlingCode = kEventHandled End If If DragState = kDragStateEndDrag Then MsgBox "kDragStateEndDrag" HandlingCode = kEventNotHandled End If End Sub Private Sub oMouseEvents_OnMouseMove(ByVal Button As MouseButtonEnum, ByVal ShiftKeys As ShiftStateEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View) Dim oSS As SelectSet Set oSS = ThisApplication.ActiveDocument.SelectSet If oSS.Count = 1 And oSS.Item(1).Type = kWorkPointObject Then Dim oWPDef As FixedWorkPointDef Set oWPDef = oWP.Definition Dim oProjectedPoint As Inventor.Point Call ProjectPoint(ModelPosition, oWPDef.Point, oProjectedPoint) ' Set a reference to the transient geometry object for user later. Dim oTransGeom As TransientGeometry Set oTransGeom = ThisApplication.TransientGeometry ' Create a graphics data set object. This object contains all of the ' information used to define the graphics. Dim oDataSets As GraphicsDataSets Set oDataSets = oIntGraphics.GraphicsDataSets If oDataSets.Count <> 0 Then oDataSets.Item(1).Delete End If ' Create a coordinate set. Dim oCoordSet As GraphicsCoordinateSet Set oCoordSet = oDataSets.CreateCoordinateSet(1) ' Create an array that contains coordinates that define a set ' of outwardly spiraling points. Dim oPointCoords(1 To 3) As Double ' Define the X, Y, and Z components of the point. oPointCoords(1) = oProjectedPoint.X oPointCoords(2) = oProjectedPoint.Y oPointCoords(3) = oProjectedPoint.Z ' Assign the points into the coordinate set. Call oCoordSet.PutCoordinates(oPointCoords) ' Create the ClientGraphics object. Dim oClientGraphics As ClientGraphics Set oClientGraphics = oIntGraphics.PreviewClientGraphics If oClientGraphics.Count <> 0 Then oClientGraphics.Item(1).Delete End If ' Create a new graphics node within the client graphics objects. Dim oPtNode As GraphicsNode Set oPtNode = oClientGraphics.AddNode(1) ' Create a PointGraphics object within the node. Dim oPtGraphics As PointGraphics Set oPtGraphics = oPtNode.AddPointGraphics ' Assign the coordinate set to the line graphics. oPtGraphics.CoordinateSet = oCoordSet oPtGraphics.PointRenderStyle = kCrossPointStyle ThisApplication.ActiveView.Update End If End Sub Private Sub oMouseEvents_OnMouseUp( _ ByVal Button As MouseButtonEnum, _ ByVal ShiftKeys As ShiftStateEnum, _ ByVal ModelPosition As Point, _ ByVal ViewPosition As Point2d, _ ByVal View As View) Dim oSS As SelectSet Set oSS = ThisApplication.ActiveDocument.SelectSet If oSS.Count = 1 And oSS.Item(1).Type = kWorkPointObject Then Dim oWPDef As FixedWorkPointDef Set oWPDef = oWP.Definition '--- Add Begin ---- Dim oMpoint As Point Set oMpoint = oModelPoint '--- Add End ---- Dim oProjectedPoint As Inventor.Point '--- Modify Begin ---- ' Call ProjectPoint(ModelPosition, oWPDef.Point, oProjectedPoint) Call ProjectPoint(oMpoint, oWPDef.Point, oProjectedPoint) '--- Modify End ---- ' Reposition the fixed work point oWPDef.Point = oProjectedPoint ThisApplication.ActiveDocument.Update oIE.Stop Set oWP = Nothing End If End Sub ' Project the ModelPosition to a plane parallel to the ' X-Y plane on which the work point currently is. Private Sub ProjectPoint(ByVal ModelPosition As Inventor.Point, ByVal WorkPointPosition As Inventor.Point, ProjectedPoint As Inventor.Point) ' Set a reference to the camera object Dim oCamera As Inventor.Camera Set oCamera = ThisApplication.ActiveView.Camera Dim oVec As Vector Set oVec = oCamera.Eye.VectorTo(oCamera.Target) Dim oLine As Line Set oLine = ThisApplication.TransientGeometry.CreateLine(ModelPosition, oVec) ' Create the z-axis vector Dim oZAxis As Vector Set oZAxis = ThisApplication.TransientGeometry.CreateVector(0, 0, 1) ' Create a plane parallel to the X-Y plane Dim oWPPlane As Plane Set oWPPlane = ThisApplication.TransientGeometry.CreatePlane(WorkPointPosition, oZAxis) Set ProjectedPoint = oWPPlane.IntersectWithLine(oLine) End Sub Private Sub oUserInputEvents_OnTerminateCommand(ByVal CommandName As String, ByVal Context As NameValueMap) MsgBox "OnTerminateCommand" End Sub
Hope this help.
Shigekazu Saito
Developer Technical Services
Autodesk Developer Network
Hi Farren,
Oops, not sure how I managed to miss this workaround esepcially after seeing Saito-san's code. 😞
You could create a workpoint that is fixed to the middle of the edge and use that to create a workplane:
Sub AddWorkplane() Dim doc As PartDocument Set doc = ThisApplication.ActiveDocument Dim cd As PartComponentDefinition Set cd = doc.ComponentDefinition ' Select an edge and run this code Dim e As Edge Set e = doc.SelectSet(1) Dim wp As WorkPlane ' This succeeds Set wp = cd.WorkPlanes.AddByNormalToCurve(e, e.StartVertex) Dim pt As WorkPoint Set pt = cd.WorkPoints.AddByMidPoint(e, True) ' This works too Set wp = cd.WorkPlanes.AddByNormalToCurve(e, pt) End Sub
Cheers,
Can't find what you're looking for? Ask the community or share your knowledge.