Manufacturing DevBlog

Check or UnCheck iProperties “Date Created” and “Date Checked” example

By Wayne Brill

It is not obvious how to add or remove a check to an iProperty such as Creation Date:

 

In the VBA watch window you will see that when the "Date Created" iProperty is not checked the Expression property of the iProperty is not a valid date. When it is checked it has a valid date. If you give the iProperty Expression a valid date value it will be checked. Using a date value of "1601, 1, 1" removes the checkmark.  

Here is a VBA example:

Public Sub iProperties_Test()
    ' Get the active document.
    Dim invDoc As Document
    Set invDoc = ThisApplication.ActiveDocument
   
    ' Get the design tracking property set.
    Dim invDesignInfo As PropertySet
    Set invDesignInfo = invDoc.PropertySets.Item("Design Tracking Properties")
       
    Dim iProp As Property
    For Each iProp In invDesignInfo
        'If iProp.Name = "Date Checked" Then
        If iProp.DisplayName = "Date Created" Then
            'Property is unchecked with this
           ' iProp.Expression = "1601, 1, 1"
            'Property is checked with this
            iProp.Expression = #7/22/2016#
           
            Exit For
        End If
    Next iProp
   
End Sub

Delete Objects with Fusion 360 API

By Xiaodong Liang

All objects that can be deleted support the the deleteMe method. The usage is  very straightforward. Get the object and call deleteMe.

I found a forum post that one customer failed to delete the object which is within the generic object collection.

http://forums.autodesk.com/t5/api-and-scripts/how-do-i-delete-a-sketch-curve-line-arc-etc/m-p/6394526#U6394526

but, it looks working well at my side. The following code demo three scenarios:

1. delete selected objects

2. delete the specific object in the collection created by UI

3. delete the specific object in the generic collection (e.g. in this code, the collection is the offset curves collection)

def deleteObjectsOfSelection():

    app = adsk.core.Application.get()
    try:      
        #assume some entities are selected
        for eachObj in app.userInterface.activeSelections:
            if eachObj.isValid:
                #get the selected entity of the selection.                
                #call deleteMe
                eachObj.entity.deleteMe()
    except:
        ui = app.userInterface
        if ui:
            ui.messageBox('Failed:\n{}'.format(traceback.format_exc()))  
            

def deleteItemOfObjCollectionItem():

    app = adsk.core.Application.get()
    
    try:
        #current product            
        product = app.activeProduct
        #current component
        rootComp = product.rootComponent 
        #get sketches collection
        sketches = rootComp.sketches
        #get one sketch 
        if sketches.count > 0:
            oneSketch = sketches.item(0)
            oneSketch.deleteMe()
       
    except:
        ui = app.userInterface
        if ui:
            ui.messageBox('Failed:\n{}'.format(traceback.format_exc()))             


def deleteItemOfGenericCollection():
    app = adsk.core.Application.get()
    ui = app.userInterface
    
    try:
      
        
        #select a sketch        
        selectedObjs = app.userInterface.activeSelections
        if selectedObjs.count == 0:
           ui.messageBox('no object is selected in the document!')
           return
        
        oneObj = selectedObjs.item(0)
        if oneObj.entity.objectType != 'adsk::fusion::Sketch':
             print( oneObj.entity.objectType)
             ui.messageBox('not a sketch!')
             return        
        sketchIn = oneObj.entity 
        
        sketchIn.isComputeDeferred = True
        
        curvesIn = sketchIn.sketchCurves
        if curvesIn.count == 0:
             ui.messageBox('no curve in the sketch!')
             return
             
        curvesForOffset = adsk.core.ObjectCollection.create() 
        offsetCurves = adsk.core.ObjectCollection.create()
        
        curvesForOffset = sketchIn.findConnectedCurves(curvesIn.item(0));
        offsetCurves = sketchIn.offset(curvesForOffset, adsk.core.Point3D.create(100,100,100), 2.0);
        
        if offsetCurves == None or offsetCurves.count ==0:
             ui.messageBox('no offset curves are created!')
             return
        
        transform = adsk.core.Matrix3D.create();
        
        #current product            
        product = app.activeProduct
        #current component
        rootComp = product.rootComponent 
        #get sketches collection
        sketches = rootComp.sketches
        
        #create a new sketch 
        sketchOut = sketches.add(rootComp.xYConstructionPlane)
        sketchIn.copy(offsetCurves, transform, sketchOut);
        
        #delete the offseted curves in sketchIn
        for eachCurve in offsetCurves:
            eachCurve.deleteMe()
        
        sketchIn.isComputeDeferred =False 
       
    except:
        ui = app.userInterface
        if ui:
            ui.messageBox('Failed:\n{}'.format(traceback.format_exc()))  
     

Cable & Harness component names

By Adam Nagy

When iterating through the components of a Cable & Harness assembly you'll find VirtualComponentDefinition's named like "HA_VC_xxx":

...
Hard Drive:2
CD Ribbon Cable
  CD Ribbon Cable
  Ribbon Cable Connector:1
  Ribbon Cable Connector:2
  Ribbon Cable Connector:3
  HA_VC_100:1
Power Supply Harness
  Power Supply Connector:1
...

This does not line up with what you see in the Browser Tree. It's because what's listed there are not actually the components but just placeholders. If you select them and run a code like this then you can see that those parts are just ClientBrowserNodeDefinitionObject's:

The Part Number of the VirtualComponentDefinition's resemble more how those components are represented in the Browser Tree, so you could use that instead:

Sub PrintHierarchyTreeRecursive(occs, indent)
  Dim occ As ComponentOccurrence
  For Each occ In occs
    Dim pss As PropertySets
    If TypeOf occ.Definition Is VirtualComponentDefinition Then
      Set pss = occ.Definition.PropertySets
    Else
      Set pss = occ.Definition.Document.PropertySets
    End If
    
    Dim partNumber As String
    partNumber = pss("Design Tracking Properties")("Part Number").value
    
    Write #1, Spc(indent); occ.Name + ", " + partNumber
    
    Call PrintHierarchyTreeRecursive(occ.SubOccurrences, indent + 2)
  Next
End Sub

Sub PrintHierarchyTree()
  Dim asm As AssemblyDocument
  Set asm = ThisApplication.ActiveDocument
  
  Open "C:\temp\assemblyparts.txt" For Output As #1
  Call PrintHierarchyTreeRecursive(asm.ComponentDefinition.Occurrences, 0)
  Close #1
End Sub

 

Add the sketch using DrawingView Sketches when creating a section view

By Wayne Brill

In the SDK help-->Inventor API User's Manual----> Drawings--->Working With Drawing Views---> “Creating a section drawing view” it includes this code:

Dim oDrawingSketch As DrawingSketch
Set oDrawingSketch = oSheet.Sketches.Add

AddSectionView() fails when the Drawing Sketch is added using the Sheet Sketches.

If the DrawingSketch is added using the View Sketches the error goes away and the Section View is created.

Dim oDrawingSketch As DrawingSketch
’ Error goes away on AddSectionView() using the base view sketches collection
Set oDrawingSketch = oView1.Sketches.Add

This issue with the sample in the SDK help has been reported to Inventor Engineering.

Overlapped Areas of Mated Bodies in Assembly

By Xiaodong Liang

Question:
I have as assembly with 2 plate parts, they are constrained to each other face to face by mate constraint. How to get their overlapped area and boundary.

Solution:
From API help: TransientBRep.ImprintBodies finds regions of faces on two bodies which overlap and creates new bodies where the faces are split at the edges of the overlaps. This does not modify the original bodies but creates new transient bodies that contain the imprints.

The code below illustrates how to get the overlapped areas of two bodies of one mate constraint. To display the area, the code creates the relevant client graphics and moves them aside of the original bodies. The area and edges are selectable.

 

    Private Sub GetOverlappedArea()

        'get active Inventor
        Dim ThisApplication As Inventor.Application =
            System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application")


        ' Get the active assembly document and its definition.
        Dim doc As AssemblyDocument
        doc = ThisApplication.ActiveDocument

        Dim def As AssemblyComponentDefinition
        def = doc.ComponentDefinition

        'assume one constraint is Mate Constraint
        Dim AConstraint As AssemblyConstraint
        AConstraint = def.Constraints(1)

        Dim oOccurrenceOne As ComponentOccurrence
        oOccurrenceOne = AConstraint.OccurrenceOne

        Dim oOccurrenceTwo As ComponentOccurrence
        oOccurrenceTwo = AConstraint.OccurrenceTwo



        ' Get the bodies in part space as transient bodies.
        Dim transBrep As TransientBRep
        transBrep = invApp.TransientBRep
        Dim body1 As SurfaceBody
        Dim body2 As SurfaceBody


        'assume the geometries in both occurrence are within the fist surface body
        'of the native model

        body1 = transBrep.Copy(oOccurrenceOne.Definition.SurfaceBodies(1))
        body2 = transBrep.Copy(oOccurrenceTwo.Definition.SurfaceBodies(1))

        ' Transform the bodies to be in the location represented in the assembly.
        Call transBrep.Transform(body1, oOccurrenceOne.Transformation)
        Call transBrep.Transform(body2, oOccurrenceTwo.Transformation)

        ' Imprint the bodies.
        Dim newBody1 As SurfaceBody
        Dim newBody2 As SurfaceBody
        Dim body1OverlapFaces As Faces
        Dim body2OverlapFaces As Faces
        Dim body1OverlapEdges As Edges
        Dim body2OverlapEdges As Edges
        Call ThisApplication.TransientBRep.ImprintBodies(body1, body2, True, newBody1, newBody2, _
                                                         body1OverlapFaces, body2OverlapFaces, _
                                                         body1OverlapEdges, body2OverlapEdges)
 
        Dim matchingIndexList1(body1OverlapFaces.Count - 1) As Integer
        Dim matchingIndexList2(body2OverlapFaces.Count - 1) As Integer
        Dim i As Integer
        For i = 1 To body1OverlapFaces.Count
            ' Find the indices of the overlapping face in the Faces collection.
            Dim j As Integer
            For j = 1 To newBody1.Faces.Count
                If body1OverlapFaces.Item(i) Is newBody1.Faces.Item(j) Then
                    matchingIndexList1(i - 1) = j
                    Exit For
                End If
            Next

            Dim body2Index As Integer
            For j = 1 To newBody2.Faces.Count
                If body2OverlapFaces.Item(i) Is newBody2.Faces.Item(j) Then
                    matchingIndexList2(i - 1) = j
                    Exit For
                End If
            Next
        Next

        ' The code below creates new non-parametric base features using the new imprinted bodies
        ' so that the results can be visualized.  The new bodies are created offset from the
        ' original so that they don't overlap and are more easily seen.

        ' Define a matrix to use in transforming the bodies.
        Dim trans As Matrix
        trans = ThisApplication.TransientGeometry.CreateMatrix

        ' Move the first imprinted body over based on the range so it doesn't lie on the original.
        trans.Cell(1, 4) = (body1.RangeBox.MaxPoint.X - body1.RangeBox.MinPoint.X) * 1.1
        Call ThisApplication.TransientBRep.Transform(newBody1, trans)

        ' Move the second imprinted body over based on the rangeso it doesn't lie on the original.
        trans.Cell(1, 4) = trans.Cell(1, 4) + (body1.RangeBox.MaxPoint.X - body1.RangeBox.MinPoint.X) * 1.1
        Call ThisApplication.TransientBRep.Transform(newBody2, trans)

        'draw the point graphics
        Dim oCoordSet As GraphicsCoordinateSet = Nothing
        Dim oGraphicsNode As GraphicsNode = Nothing
        Dim oDataSets As GraphicsDataSets = Nothing

        'get datasets, dataset, graphics node for client graphics
        getCG(oGraphicsNode, oCoordSet, oDataSets)

        oGraphicsNode.Selectable = True

        'add surface Graphics
        Dim oBody1Graphics As SurfaceGraphics
        oBody1Graphics = oGraphicsNode.AddSurfaceGraphics(newBody1)
        oBody1Graphics.ChildrenAreSelectable = True
        For i = 1 To oBody1Graphics.DisplayedFaces.Count
            oBody1Graphics.DisplayedFaces.Item(i).Selectable = True
        Next

        Dim oBody2Graphics As SurfaceGraphics
        oBody2Graphics = oGraphicsNode.AddSurfaceGraphics(newBody2)

        oBody2Graphics.ChildrenAreSelectable = True
        For i = 1 To oBody2Graphics.DisplayedFaces.Count
            oBody2Graphics.DisplayedFaces.Item(i).Selectable = True
        Next

 
        ThisApplication.ActiveView.Update()

        'Now the faces of client graphics are selectable. The overlapped faces can be selected.

'help function
Private Sub getCG(ByRef oGraphicsNode As Object, _
                     Optional ByRef oCoordSet As Object = Nothing, _
                     Optional ByRef oOutDataSets As Object = Nothing)

        Dim oDoc As Document
        oDoc = invApp.ActiveDocument

        Dim oDataOwner As Object = Nothing
        Dim oGraphicsOwner As Object = Nothing

        'check the document type and get the owner of the datasets and graphics
        If oDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Or oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
            oDataOwner = oDoc
            oGraphicsOwner = oDoc.ComponentDefinition
        ElseIf oDoc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
            If oDoc.ActiveSheet Is Nothing Then
                MsgBox("The current document is a drawing. The command is supposed to draw client graphics on active sheet! But active sheet is null!")
                Exit Sub
            Else
                oDataOwner = oDoc.ActiveSheet
                oGraphicsOwner = oDoc.ActiveSheet
            End If
        End If

        'delete the data sets and graphics if they exist
        Try
            oDataOwner.GraphicsDataSetsCollection("TestCG").Delete()
        Catch ex As Exception
        End Try

        Try
            oGraphicsOwner.ClientGraphicsCollection("TestCG").Delete()
        Catch ex As Exception
        End Try

        'create DataSets 
        Dim oDataSets As GraphicsDataSets = oDataOwner.GraphicsDataSetsCollection.Add("TestCG")
        oOutDataSets = oDataSets

        'create one coordinate data set
        oCoordSet = oDataSets.CreateCoordinateSet(oDataSets.Count + 1)

        'create graphics node
        Dim oClientGraphics As Inventor.ClientGraphics = oGraphicsOwner.ClientGraphicsCollection.Add("TestCG")
        oGraphicsNode = oClientGraphics.AddNode(oClientGraphics.Count + 1)

    End Sub

    End Sub

Map family's table column to Inventor property

By Adam Nagy

When trying to figure out how to do something in the Inventor API, then almost always the best way to go is: do it in the UI, investigate in the API.

So I registered in the Content Center my own part, created a SIZE property then mapped it to Project.Description (Design Tracking Properties:Description):

Now using the API I can find out how the SIZE property got mapped to Project.Description property:

Public Sub CCtest()
  Dim cc As ContentCenter
  Set cc = ThisApplication.ContentCenter
  
  Dim ctvn As ContentTreeViewNode
  Set ctvn = cc.TreeViewTopNode. _
    ChildNodes("Features"). _
    ChildNodes("English"). _
    ChildNodes("Block")
    
  Dim cf As ContentFamily
  Set cf = ctvn.Families(1)
  
  Dim ctc As ContentTableColumn
  Set ctc = cf.TableColumns("Size")
  
  If ctc.HasPropertyMap Then
    Dim psid As String
    Dim pid As String
    Call ctc.GetPropertyMap(psid, pid)
    Debug.Print "PropertySetId = " & psid
    Debug.Print "PropertyId = " & pid
  End If
End Sub

Result:

PropertySetId = {32853F0F-3444-11d1-9E93-0060B03C1CA6}
PropertyId = 29

So basically you just have to look for the given property set in Document.PropertySets and use its InternalName property, then look for the property inside it and use the Property's PropId.

Edit an Item BOM Row in Vault – VB example

By Wayne Brill

Here is a VB example that changes the Quantity of a BOM Row. To test this code you can add a button to this SDK sample:

C:\Program Files (x86)\Autodesk\Autodesk Vault 2016 SDK\vs12\VB\ItemEditor

 

After the code runs you can see the Quantity being changed in Vault Explorer. The ItemBOM and ItemAssoc are retrieved from the Item being edited. 

Private Sub Button1_Click_WB(sender As Object, e As EventArgs) Handles Button1.Click
    Dim parentItem As Item = m_selectedItem
    'Change this to use an Item Number in your vault
    Dim ChildItem As Item = m_connection.WebServiceManager.ItemService.GetLatestItemByItemNumber("100001")
    Dim newQty As Integer = 2
    updateBOMQuantity_WB(parentItem, ChildItem, newQty)
End Sub

Private Sub updateBOMQuantity_WB(parentItem As Item, childItem As Item, newQty As Integer)
    Dim item2 As Item = Nothing
    Try
        item2 = m_connection.WebServiceManager.ItemService.EditItems(New Long() {m_selectedItem.RevId})(0)

        Dim options As BOMViewEditOptions = BOMViewEditOptions.Defaults Or BOMViewEditOptions.ReturnOccurrences _
                     Or BOMViewEditOptions.ReturnExcluded Or BOMViewEditOptions.ReturnUnassignedComponents

        ' Get the ItemBOM from the Item being edited
        Dim bom As ItemBOM = m_connection.WebServiceManager.ItemService.GetItemBOMByItemIdAndDate _
                                (item2.Id, DateTime.MinValue, BOMTyp.Latest, options)

        ' Get the ItemAssoc from the ItemBOM being edited
        Dim itemAssoc2 As ItemAssoc =
            bom.ItemAssocArray.FirstOrDefault(Function(x) x.CldItemMasterID = childItem.MasterId)

        Dim newBomItemAssocParam2 As New ItemAssocParam
        newBomItemAssocParam2.Id = itemAssoc2.Id
        newBomItemAssocParam2.EditAct = BOMEditAction.Update
        newBomItemAssocParam2.Quant = newQty

        Dim bom2 As ItemBOM = m_connection.WebServiceManager.ItemService.UpdateItemBOMAssociations _
                  (item2.Id, {newBomItemAssocParam2}, BOMViewEditOptions.ReturnBOMFragmentsOnEdits)

        m_connection.WebServiceManager.ItemService.UpdateAndCommitItems(New Item() {item2})

    Catch ex As Exception
        MsgBox(ex.Message)
        m_connection.WebServiceManager.ItemService.UndoEditItems(New Long() {item2.Id})
    End Try
End Sub

Configure Options of SaveAs DWG of Part or Assembly

By Xiaodong Liang

Question:
When we export document to DWG, the options are provided with an *,ini file. It works well with the DrawingDocument. While when saving as part/assembly file to DWG, there are some other options.

But it looks *.ini file does not work with Part or Assembly. How can we configure them?

 

Solution:

Those additional options can be explicitly appended to Option array. The code below is a demo. 

Public Sub PublishDWG()
    ' Get the DWG translator Add-In.
    Dim DWGAddIn As TranslatorAddIn
    Set DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument
        
    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism

    ' Create a NameValueMap object
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

    ' Check whether the translator has 'SaveCopyAs' options
    If DWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
        
        If oDocument.DocumentType = kPartDocumentObject Or oDocument.DocumentType = kAssemblyDocumentObject Then
            oOptions.Value("Solid") = True
            oOptions.Value("Surface") = True
            oOptions.Value("Sketch") = True
            oOptions.Value("DwgVersion") = 31
        End If
        
        If oDocument.DocumentType = kDrawingDocumentObject Then
            Dim strIniFile As String
            strIniFile = "C:\tempDWGOut.ini"
            ' Create the name-value that specifies the ini file to use.
            oOptions.Value("Export_Acad_IniFile") = strIniFile
        End If
    End If

    'Set the destination file name
    oDataMedium.FileName = "c:\tempdwgout.dwg"

    'Publish document.
    Call DWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub

Filter out faces not facing the user

By Adam Nagy

The API Help contains a sample that lets you prompt the user to select a Face. This is helped by the option of specifying the object types we allow:

oSelectEvents.AddSelectionFilter filter

If you need more granularity when deciding which faces should be selectable then you can just handle the OnPreSelect event of the SelectEvents object. There you can check e.g. if the Face is planar or not, and in which direction its Normal is pointing. If e.g. it's pointing away from the user then you could make it not selectable:

Module

Public Sub TestSelection()
    ' Create a new clsSelect object.
    Dim oSelect As New clsSelect

    ' Call the pick method of the clsSelect object and set
    ' the filter to pick any face.
    Dim oFaces As ObjectsEnumerator
    Set oFaces = oSelect.Pick(kPartFaceFilter)

    ' Check to make sure an object was selected.
    Dim oSelSet As SelectSet
    Set oSelSet = ThisApplication.ActiveDocument.SelectSet
    
    For Each oFace In oFaces
      oSelSet.Select oFace
    Next
End Sub

clsSelect

'*************************************************************
' The declarations and functions below need to be copied into
' a class module whose name is "clsSelect". The name can be
' changed but you'll need to change the declaration in the
' calling function "TestSelection" to use the new name.

' Declare the event objects
Private WithEvents oInteractEvents As InteractionEvents
Private WithEvents oSelectEvents As SelectEvents

' Declare a flag that's used to determine when selection stops.
Private bStillSelecting As Boolean

Public Function Pick(filter As SelectionFilterEnum) As ObjectsEnumerator
  ' Initialize flag.
  bStillSelecting = True

  ' Create an InteractionEvents object.
  Set oInteractEvents = ThisApplication.CommandManager.CreateInteractionEvents

  ' Ensure interaction is enabled.
  oInteractEvents.InteractionDisabled = False

  ' Set a reference to the select events.
  Set oSelectEvents = oInteractEvents.SelectEvents
  oSelectEvents.WindowSelectEnabled = True

  ' Set the filter using the value passed in.
  oSelectEvents.AddSelectionFilter filter

  ' Start the InteractionEvents object.
  oInteractEvents.Start

  ' Loop until a selection is made.
  Do While bStillSelecting
    ThisApplication.UserInterfaceManager.DoEvents
  Loop

  ' Get the selected item. If more than one thing was selected,
  ' just get the first item and ignore the rest.
  Dim oSelectedEnts As ObjectsEnumerator
  Set oSelectedEnts = oSelectEvents.SelectedEntities
  If oSelectedEnts.Count > 0 Then
    Set Pick = oSelectedEnts
  Else
    Set Pick = Nothing
  End If

  ' Stop the InteractionEvents object.
  oInteractEvents.Stop

  ' Clean up.
  Set oSelectEvents = Nothing
  Set oInteractEvents = Nothing
End Function

Private Sub oInteractEvents_OnTerminate()
  ' Set the flag to indicate we're done.
  bStillSelecting = False
End Sub

Private Sub oSelectEvents_OnPreSelect( _
PreSelectEntity As Object, DoHighlight As Boolean, _
MorePreSelectEntities As ObjectCollection, _
ByVal SelectionDevice As SelectionDeviceEnum, _
ByVal ModelPosition As Point, _
ByVal ViewPosition As Point2d, ByVal View As View)
   If Not TypeOf PreSelectEntity Is Face Then Exit Sub
   
   Dim oFace As Face
   Set oFace = PreSelectEntity
   
   If Not TypeOf oFace.Geometry Is Plane Then Exit Sub
   
   Dim oPlane As Plane
   Set oPlane = oFace.Geometry
   
   Dim oViewDir As Vector
   Set oViewDir = View.Camera.Eye.VectorTo(View.Camera.Target)
   
   If oFace.IsParamReversed Then
     oViewDir.ScaleBy -1
   End If
   
   ' The direction the user is looking into and the face's
   ' normal the same then the dot product is positive, so
   ' we won't highlight the face
   If oPlane.Normal.DotProduct(oViewDir.AsUnitVector()) > 0 Then
     ' Without this all 6 faces of the box would be selected
     DoHighlight = False
   End If
End Sub

Private Sub oSelectEvents_OnSelect( _
ByVal JustSelectedEntities As ObjectsEnumerator, _
ByVal SelectionDevice As SelectionDeviceEnum, _
ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
  ' Set the flag to indicate we're done.
  bStillSelecting = False
End Sub

Only the 3 user facing faces are selected.

Get Closest Point on DrawingCurve

By Xiaodong Liang  

A customer wanted to get the closest point on a drawing curve when the user clicks a location on the sheet. The workflow is simple: start mouse event, watch MouseEvent.OnMouseClick. In the event, calculate the closest point on the curve. 

However, it looks API only provides GetClosestPoint method for Edge and Face. So we would need to calculate the closest point ourselves. There are many discussions on the algorism how to get a nearest point of 2D curve, I tested with the simplest one: disperse the parameters of a curve, then get the point, calculate the distance with the mouse point, find the shortest one. 

The below is the code of MouseEvent. The whole code project is attached. It is a standalone EXE. It assumes a drawing curve is selected, then click [start event], mouse click a location, the closest point will be displayed as a client graphics point. Click [stop event] to terminate the custom mouse event.

Download ClosesPoint

you can change to other more efficient algorism of getting close point.

 

 Private Sub oME_OnMouseClick(Button As MouseButtonEnum, ShiftKeys As ShiftStateEnum, ModelPosition As Point, ViewPosition As Point2d, View As View) Handles oME.OnMouseClick
 
        Dim oPickPtX = ModelPosition.X
        Dim oPickPtY = ModelPosition.Y


        Dim oCurve As DrawingCurve
        oCurve = oOneDrawingCurve.Parent
         
        Dim oEvaluator As Curve2dEvaluator
        oEvaluator = oCurve.Evaluator2D

        Dim oMinP, oMaxP
        oEvaluator.GetParamExtents(oMinP, oMaxP)

        Dim oMinDis = 100000000000.0 

        ' Get the curve length
        Dim dLen As Double
        Call oEvaluator.GetLengthAtParam(oMinP, oMaxP, dLen)

        Dim dInc As Double
        dInc = dLen / 100  'consider 100 points         

        Dim dLenInc As Double
        dLenInc = 0

        Dim dparams(0) As Double
        dparams(0) = oMinP

        Dim iCnt As Integer

        Dim oClosestPtX As Double = 0
        Dim oClosestPtY As Double = 0

        For iCnt = 0 To 100
            Dim dParam As Double
            Call oEvaluator.GetParamAtLength(oMinP,
                               dInc * iCnt,
                               dParam)
            ' a spline in planar sketch is 2d. its points are
            ' 2d (x,y)
            Dim dPts(1) As Double
            dparams(0) = dParam

            Call oEvaluator.GetPointAtParam(dparams, dPts)

            Dim oEachDis = Math.Sqrt(Math.Pow((dPts(0) - oPickPtX), 2) + 
                                     Math.Pow((dPts(1) - oPickPtY), 2))

            'smaller distance?
            If (oEachDis < oMinDis) Then
                oMinDis = oEachDis
                oClosestPtX = dPts(0)
                oClosestPtY = dPts(1)

            End If
        Next
           
       

        'draw the point graphics
        Dim oCoordSet As Object = Nothing
        Dim oGraphicsNode As Object = Nothing
        Dim oDataSets As Object = Nothing

        'get datasets, dataset, graphics node
        getCG(oGraphicsNode, oCoordSet, oDataSets)

        'prepare the coordinates
        Dim oPointCoords(2) As Double
        oPointCoords(0) = oClosestPtX : oPointCoords(1) = oClosestPtY : oPointCoords(2) = 0
        'oPointCoords(0) = dPts(0) : oPointCoords(1) = dPts(1) : oPointCoords(2) = 0

        Call oCoordSet.PutCoordinates(oPointCoords)

        'add PointGraphics
        Dim oPointGraphics As PointGraphics
        oPointGraphics = oGraphicsNode.AddPointGraphics

        'set the related 
        oPointGraphics.PointRenderStyle = PointRenderStyleEnum.kCrossPointStyle
        oPointGraphics.CoordinateSet = oCoordSet


        oPointGraphics.BurnThrough = True

        invApp.ActiveView.Update()

    End Sub