Give this a try....it should be close to what you want.
Class Etching
Shared bStillSelecting As Boolean
Shared oModelPoint as Point
Shared oModelFace As Face
Sub Main()
' Declarations
bStillSelecting = True
Dim oPartDoc as PartDocument
Try
oPartDoc = ThisApplication.ActiveDocument
Catch ex as Exception
Return
End Try
Dim oTG as TransientGeometry
oTG = ThisApplication.TransientGeometry
' Check for existing features
Dim bExistingSketch As Boolean = False
Dim oExistSketch as PlanarSketch
For each oExistSketch in oPartDoc.ComponentDefinition.Sketches
If oExistSketch.Name = "Engraving_Sketch" Then bExistingSketch = True
Next
Dim bExistingWPO As Boolean = False
Dim oExistWPO as WorkPoint
For each oExistWPO in oPartDoc.ComponentDefinition.WorkPoints
If oExistWPO.Name = "Engraving_Point" Then bExistingWPO = True
Next
Dim bExistingFeature As Boolean = False
Dim oExistFeature as ExtrudeFeature
For each oExistFeature in oPartDoc.ComponentDefinition.Features.ExtrudeFeatures
If oExistFeature.Name = "Engraving_Feature" Then bExistingFeature = True
Next
' If existing, exit rule
If bExistingSketch OR bExistingWPO OR bExistingFeature Then Return
' Get the camera from the view.
Dim oCamera As Camera
oCamera = ThisApplication.ActiveView.Camera
' Get perspective of existing view
Dim bPerspectiveCamera as Boolean
bPerspectiveCamera = oCamera.Perspective
' Set camera to ortho
oCamera.Perspective = False
oCamera.Apply
' Start InteractionEvents
Dim oInteraction As InteractionEvents
oInteraction = ThisApplication.CommandManager.CreateInteractionEvents
oInteraction.StatusBarText = "Select face at point"
Dim oMouse As MouseEvents
oMouse = oInteraction.MouseEvents
AddHandler oMouse.OnMouseClick ,AddressOf oMouse_OnMouseDown
oInteraction.Start
Do While bStillSelecting
ThisApplication.UserInterfaceManager.DoEvents
Loop
' Stop InteractionEvents
oInteraction.Stop()
ThisApplication.CommandManager.StopActiveCommand
bStillSelecting = False
' Create workpoint
Dim oWPO as Workpoint
If Not oModelPoint Is Nothing Then
oWPO = oPartDoc.ComponentDefinition.WorkPoints.AddFixed(oModelPoint)
oWPO.Name = "Engraving_Point"
oWPO.Visible = False
Else
Return
End If
' Create Sketch
Dim oEngravedSketch As PlanarSketch
oEngravedSketch = oPartDoc.ComponentDefinition.Sketches.Add(oModelFace, False)
oEngravedSketch.OriginPoint = oWPO
oEngravedSketch.Name = "Engraving_Sketch"
Dim oSelectedPoint2d as Point2d
oSelectedPoint2d = oTG.CreatePoint2d(0, 0)
Trace.Writeline("iLogic: oSelectedPoint2d: " & oSelectedPoint2d.X & "," & oSelectedPoint2d.Y)
' Add text
Dim sTextEngraved As String
sTextEngraved = iProperties.Value("Project", "Part Number")
Trace.WriteLine("iLogic: sTextEngraved: " & sTextEngraved)
Dim oTextBox As Inventor.TextBox
oTextBox = oEngravedSketch.TextBoxes.AddFitted(oSelectedPoint2d, sTextEngraved)
oTextBox.HorizontalJustification = kAlignTextCenter
oTextBox.VerticalJustification = kAlignTextMiddle
Dim dTextSize As Double
dTextSize = 0.3175 ' value is in cm. equals .125 in
Dim sTextFont As String
sTextFont = "SIMPLEX"
oTextBox.FormattedText = "<StyleOverride Font = '" & sTextFont & "' FontSize = '" & dTextSize & "'>" & _
sTextEngraved & "</StyleOverride>"
' Create extrusion
Dim oProfile As Profile
Dim oExtrudeDef As ExtrudeDefinition
Dim oExtrude As ExtrudeFeature
oProfile = oEngravedSketch.Profiles.AddForSolid
Trace.WriteLine("iLogic: oProfile Selected")
oExtrudeDef = oPartDoc.ComponentDefinition.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
Call oExtrudeDef.SetDistanceExtent(0.1 , kNegativeExtentDirection)
oExtrude = oPartDoc.ComponentDefinition.Features.ExtrudeFeatures.Add(oExtrudeDef)
oExtrude.Name = "Engraving_Feature"
' Set camera back to perspective if required
If bPerspectiveCamera Then
oCamera.Perspective = bPerspectiveCamera
oCamera.Apply
End If
' Clean up
oMouse = Nothing
oInteraction = Nothing
End Sub
Sub oMouse_OnMouseDown(Button As MouseButtonEnum, ShiftKeys As ShiftStateEnum, ModelPosition As Point, ViewPosition As Point2d, oView As View)
Trace.Writeline("iLogic: Debug oMouse_OnMouseDown Just Fired")
Trace.Writeline("iLogic: oMouse_OnMouseDown 1")
oModelPoint = GetPointOnFace(ModelPosition, oView)
oModelFace = GetFace(ModelPosition, oView)
bStillSelecting = False
End Sub
Sub oInteraction_OnTerminate()
Trace.Writeline("iLogic: Debug oInteraction_OnTerminate Just Fired")
bStillSelecting = False
End Sub
Function GetPointOnFace(oPoint As Point, oView As View) As Point
Trace.Writeline("iLogic: Debug GetPointOnFace Just Fired")
' Get the view direction, i.e. the vector pointing from the Eye to the Target
Dim oEyeToTargetVector As Vector
oEyeToTargetVector = oView.Camera.eye.VectorTo(oView.Camera.Target)
' The vector that will take the Model Point from the
' Target plane to the Screen plane is the opposite of oEyeToTargetVector
Dim oModelToScreenPlane As Vector
oModelToScreenPlane = oEyeToTargetVector.Copy
oModelToScreenPlane.ScaleBy (-1)
Call oPoint.TranslateBy(oModelToScreenPlane)
Dim oPartDoc As PartDocument
oPartDoc = oView.Document
' Shoot a ray from the Screen plane towards the model along the view direction to
' find the first object it hits and the intersection point
Dim oObject**** As ObjectsEnumerator
Dim oIntersectionPoints As ObjectsEnumerator
Call oPartDoc.ComponentDefinition.FindUsingRay(oPoint, oEyeToTargetVector.AsUnitVector(), 0.001, oObject****, oIntersectionPoints)
If oIntersectionPoints.Count > 0 Then
Return oIntersectionPoints(1)
End If
End Function
Function GetFace(oPoint As Point, oView As View) As Face
Trace.Writeline("iLogic: Debug GetFace Just Fired")
' Get the view direction, i.e. the vector pointing from the Eye to the Target
Dim oEyeToTargetVector As Vector
oEyeToTargetVector = oView.Camera.eye.VectorTo(oView.Camera.Target)
' The vector that will take the Model Point from the
' Target plane to the Screen plane is the opposite of oEyeToTargetVector
Dim oModelToScreenPlane As Vector
oModelToScreenPlane = oEyeToTargetVector.Copy
oModelToScreenPlane.ScaleBy (-1)
Call oPoint.TranslateBy(oModelToScreenPlane)
Dim oPartDoc As PartDocument
oPartDoc = oView.Document
' Shoot a ray from the Screen plane towards the model along the view direction to
' find the first object it hits and the intersection point
Dim oObject**** As ObjectsEnumerator
Dim oIntersectionPoints As ObjectsEnumerator
Call oPartDoc.ComponentDefinition.FindUsingRay(oPoint, oEyeToTargetVector.AsUnitVector(), 0.001, oObject****, oIntersectionPoints)
If oObject****.Count > 0 Then
Return oObject****(1)
End If
End Function
End Class
Thanks,
Randy Mabery
Applications Expert
IMAGINiT Technologies
