Creating QC Inspection Numbers using NX Journal

Do you need a NX Journal that will allow you to add numbers to your existing dimensions? Take a look at the journal below that was specifically designed to ad QC inspection numbers to existing dimensions and/or notes.

Journal Capabilities: After your journal has started, you will be required to specify a starting number for your labels. After entering your starting number, choose the dimensions or notes. The ID symbol text will start with the number you specified and increment by 1 each pick. The journal will then add an associative ID symbol to the dimension or note chosen.

Journal Requirements: This journal assumes you have the drafting application active.

 

NX Journal: Creating QC Inspection Numbers for Dimensions or Notes

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.UI
Imports NXOpen.Annotations
 
 
Module NXJournal
Sub Main
 
'*************************************************************************
'change the following offset distances to get something that works for you
'offsets from dimension text
Const XOffsetDim as Double = 0
Const YOffsetDim as Double = 2
'offsets from notes
Const XOffsetNote as Double = -3
Const YOffsetNote as Double = 0
'*************************************************************************
 
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim lw As ListingWindow = theSession.ListingWindow
Dim noteDim As Annotation
Dim noteDimOrigin as Point3D = Nothing
'Dim letterPref as LetteringPreferences = Nothing
Dim symbolPref as SymbolPreferences = Nothing
Dim noteNumber as Integer
Dim input as String
'Dim theAnnotationManager as NXOpen.Annotations.AnnotationManager = workPart.Annotations
Dim theAnnotationManager as AnnotationManager = workPart.Annotations
 
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Start")
 
Do
    input = InputBox("Enter starting QC number: ", "Label dimensions with QC inspection numbers", "1")
Loop Until (isNumeric(input))
noteNumber = input
 
'lw.Open()
 
While selectNoteDimension("Select Dimension or Note", noteDim) = Selection.Response.Ok
    noteDimOrigin = noteDim.AnnotationOrigin
    'lw.WriteLine("origin: " & noteDimOrigin.X & ", " & noteDimOrigin.Y)
    'letterPref = noteDim.GetLetteringPreferences()
    symbolPref = theAnnotationManager.Preferences.GetSymbolPreferences()
    'lw.WriteLine("Alignment Position: " & letterPref.AlignmentPosition.ToString())
    'lw.WriteLine("ID Symbol size: " & symbolPref.IDSymbolSize)
    'lw.WriteLine("Annotation type: " & noteDim.GetType().ToString())
 
    Dim nullAnnotations_IdSymbol As Annotations.IdSymbol = Nothing
    Dim idSymbolBuilder1 As Annotations.IdSymbolBuilder
 
    idSymbolBuilder1 = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(nullAnnotations_IdSymbol)
    idSymbolBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.XyPlane
    idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.TriangleUp
    idSymbolBuilder1.UpperText = noteNumber
    'use the symbol size set in the part
    idSymbolBuilder1.Size = symbolPref.IDSymbolSize
 
    Dim assocOrigin1 As Annotations.Annotation.AssociativeOriginData
    With assocOrigin1
        .OriginType = Annotations.AssociativeOriginType.OffsetFromText
        .OffsetAnnotation = noteDim
        .OffsetAlignmentPosition = Annotations.AlignmentPosition.TopLeft
        if noteDim.GetType().ToString() = "NXOpen.Annotations.Note" Then
            .XOffsetFactor = XOffsetNote
            .YOffsetFactor = YOffsetNote
        Else
            .XOffsetFactor = XOffsetDim
            .YOffsetFactor = YOffsetDim
        End if
    End With
    idSymbolBuilder1.Origin.SetAssociativeOrigin(assocOrigin1)
 
    Dim QC_IDSymbol As IDSymbol
    QC_IDSymbol = idSymbolBuilder1.Commit()
    'change IDSymbol layer to match that of the dimension or note it is attached to
    QC_IDSymbol.Layer = noteDim.Layer
    idSymbolBuilder1.Destroy()
 
    noteNumber += 1
 
End While
'lw.Close
theSession.SetUndoMarkName(markId1, "Label Dimensions")
theSession.SetUndoMarkVisibility(markId1, Nothing, Session.MarkVisibility.Visible)        
 
End Sub 'Main
 
'**************************************************
    Function selectNoteDimension(ByVal prompt As String, ByRef obj As Annotation)
    'Annotation class covers dimensions and notes
    'Annotation -> Dimension
    'Annotation -> DraftingAid -> SimpleDraftingAid -> NoteBase -> BaseNote -> Note
        Dim ui As UI = GetUI()
        Dim mask(1) As Selection.MaskTriple
        With mask(0)
            .Type = UFConstants.UF_dimension_type
            .Subtype = 0
            .SolidBodySubtype = 0
        End With
        With mask(1)
            .Type = UFConstants.UF_drafting_entity_type
            .Subtype = UFConstants.UF_draft_note_subtype
            .SolidBodySubtype = 0
        End With
 
        Dim cursor As Point3d = Nothing
 
        Dim resp As Selection.Response = _
        ui.SelectionManager.SelectObject(prompt, prompt, _
            Selection.SelectionScope.AnyInAssembly, _
            Selection.SelectionAction.ClearAndEnableSpecific, _
            False, False, mask, obj, cursor)
 
        If resp = Selection.Response.ObjectSelected Or _
        resp = Selection.Response.ObjectSelectedByName Then
            Return Selection.Response.Ok
        Else
            Return Selection.Response.Cancel
        End If
    End Function    'selectNoteDimension
'**************************************************
 
End Module

Comments

Thanks for the post! Do you know if this can be done with PMI through journeling as well? I saw a demo of the BCT software that does this and a bunch more automation (in NX) and it looks really slick. Would love to be able to do it myself.

Do you mean adding callout notes to PMI dimensions that exist in the modeling application?

Thanks, just realized you posted back.
Yeah that is what I mean.  Check out this link and take a look at the NX vid.
http://www.bct-technology.com/en/products-solutions/bct-software-products/bct-inspector-suite/
 
Although this has alot more then just adding ballons, I figured maybe this journal could be a good starting point.

Check out this link and take a look at the NX
https://www.youtube.com/watch?v=7OMXtlmP7rU

I did want to add some dimension reporting in the next version. That package looks pretty useful.
 
Unfortunately, I do not have a PMI license to play with!!

Hi, I am unable to get the collection of surface finish symbols in a drawing file.Please guide me with some sample code.Please respond immidiately.

I couldn't find any property or a method which helps me to differentiate between a normal dimension and a dimension with manual text.(i.e., text of dimension edited after placing it, not  the appended text).Please help me to resolve this issue?

You can access the surface finish symbols with: <part>.Annotations.DraftingSurfaceFinishSymbols
which will return a NXOpen.Annotations.DraftingSurfaceFinishCollection
if you prefer working with an array, you can use the .ToArray() method
<part>.Annotations.DraftingSurfaceFinishSymbols.ToArray()
 
For the manual text dimension question, I have sent some code to the email address you registered with. For anyone else interested, I will do a quick write up and post it in the tutorials section soon.

       Thanks for your timely help.

How would you go about reporting out the value of the dimension or note that the symbol is "attached" to? Would you use GetObjectIndex and work from there?

After I wrote that code I thought of several ways to improve it. One feature I'd like to add is a better way to identify the symbol with the dimension (through the use of attributes and/or entity names). I've not made the time to revisit this code, which is unfortunate as it (with improvements) would have come in handy recently.

Anyway, if you are using the code "as-is", below is a way to get the dimension given the ID symbol. The journal will prompt you to select a callout and will write the dimension tag and main text to the listing window.

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
 
Module Module1
 
    Sub Main()
 
        Dim theSession As Session = Session.GetSession()
        Dim theUfSession As UFSession = UFSession.GetUFSession()
        Dim lw As ListingWindow = theSession.ListingWindow
        lw.Open()
 
        Dim myIDsymbol As Annotations.IdSymbol
 
        If SelectDimCallout("select callout", myIDsymbol) = Selection.Response.Cancel Then
            Return
        End If
 
        lw.WriteLine("ID symbol tag: " & myIDsymbol.Tag.ToString)
        lw.WriteLine("has associative origin: " & myIDsymbol.HasAssociativeOrigin.ToString)
 
        Dim symbolAssociativity() As UFDrf.AssociativeOrigin
        Dim symbolOrigin(2) As Double
        theUfSession.Drf.AskAssociativeOrigin(myIDsymbol.Tag, symbolAssociativity, symbolOrigin)
 
        lw.WriteLine("offset annotation: " & symbolAssociativity(0).offset_annotation.ToString)
 
        Dim inspectionDim As Annotations.Dimension
        inspectionDim = Utilities.NXObjectManager.Get(symbolAssociativity(0).offset_annotation)
 
        Dim inspectionDimText() As String
        Dim inspectionDualText() As String
        inspectionDim.GetDimensionText(inspectionDimText, inspectionDualText)
        lw.WriteLine("inspection dim: " & inspectionDimText(0))
 
        lw.Close()
 
    End Sub
 
    Function SelectDimCallout(ByVal prompt As String, ByRef theID As Annotations.IdSymbol) As Selection.Response
 
        Dim selObj As TaggedObject
        Dim theUI As UI = UI.GetUI
        Dim title As String = "Select a dimension callout"
        Dim includeFeatures As Boolean = False
        Dim keepHighlighted As Boolean = False
        Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
        Dim cursor As Point3d
        Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPart
        Dim selectionMask_array(0) As Selection.MaskTriple
 
        With selectionMask_array(0)
            .Type = UFConstants.UF_drafting_entity_type
            .Subtype = UFConstants.UF_draft_id_symbol_subtype
        End With
 
        Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(prompt, _
         title, scope, selAction, _
         includeFeatures, keepHighlighted, selectionMask_array, _
         selObj, cursor)
        If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
            theID = selObj
            Return Selection.Response.Ok
        Else
            Return Selection.Response.Cancel
        End If
 
    End Function
 
    Public Function GetUnloadOption(ByVal dummy As String) As Integer
 
        'Unloads the image when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination
 
    End Function
 
End Module

Please share any suggestions you have for new features or improvements. Thanks!

Check out this link and take a look at the NX
https://www.youtube.com/watch?v=7OMXtlmP7rU

I'm trying to modify this code so that all of the dimensions (and FCFs and surface features) are automatically labeled in numeric order, but I keep getting an error "Balloon size must be greater than 0."

Would you happen to have code that does this?

I don't have code on hand to do that, but if you post what you have so far I'll try to help debug it.

I've been working with this, trying to figure out what to modify to get it to label each dimension/FCF automatically with a balloon.

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim lw As ListingWindow = theSession.ListingWindow
Dim noteDim As Annotation
Dim noteDimOrigin as Point3D = Nothing
'Dim letterPref as LetteringPreferences = Nothing
Dim symbolPref as SymbolPreferences = Nothing
Dim noteNumber as Integer
Dim input as String
'Dim theAnnotationManager as NXOpen.Annotations.AnnotationManager = workPart.Annotations
Dim theAnnotationManager as AnnotationManager = workPart.Annotations
 
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Start")
 
For Each myDimension As Annotations.Dimension In workPart.Dimensions
 
noteDimOrigin = noteDim.AnnotationOrigin
    symbolPref = theAnnotationManager.Preferences.GetSymbolPreferences()
 
    Dim nullAnnotations_IdSymbol As Annotations.IdSymbol = Nothing
    Dim idSymbolBuilder1 As Annotations.IdSymbolBuilder
 
    idSymbolBuilder1 = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(nullAnnotations_IdSymbol)
    idSymbolBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.XyPlane
    idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.TriangleUp
    idSymbolBuilder1.UpperText = noteNumber
    'use the symbol size set in the part
    idSymbolBuilder1.Size = symbolPref.IDSymbolSize
 
    Dim assocOrigin1 As Annotations.Annotation.AssociativeOriginData
    With assocOrigin1
        .OriginType = Annotations.AssociativeOriginType.OffsetFromText
        .OffsetAnnotation = noteDim
        .OffsetAlignmentPosition = Annotations.AlignmentPosition.TopLeft
        if noteDim.GetType().ToString() = "NXOpen.Annotations.Note" Then
            .XOffsetFactor = XOffsetNote
            .YOffsetFactor = YOffsetNote
        Else
            .XOffsetFactor = XOffsetDim
            .YOffsetFactor = YOffsetDim
        End if
    End With
    idSymbolBuilder1.Origin.SetAssociativeOrigin(assocOrigin1)
 
    Dim QC_IDSymbol As IDSymbol
    QC_IDSymbol = idSymbolBuilder1.Commit()
    'change IDSymbol layer to match that of the dimension or note it is attached to
    QC_IDSymbol.Layer = noteDim.Layer
    idSymbolBuilder1.Destroy()
 
    noteNumber += 1
 
Next

"Balloon size must be greater than zero"

You might want to check the value of symbolPref.IDSymbolSize before you create the balloon. If it is below some predetermined small value, supply a reasonable default size to use instead.

I was able to get auto ballooning to work with the code below, but for some reason I have to run the code twice each time. The first time, no balloons are created, but when I run the code a second time, all of the dimensions are ballooned as I want. Does anyone know why this might be happened?

 
 
'IMPROVED BALLOONING - HEXAGONAL LABELS, FILLED IN 
 
				'change the following offset distances to get something that works for you
				'offsets from dimension text
				Const XOffsetDim as Double = 0
				Const YOffsetDim as Double = 2
				'offsets from notes
				Const XOffsetNote as Double = -3
				Const YOffsetNote as Double = 0
 
 
				'Dim noteDim As Annotation
				'Dim noteDimOrigin as Point3D = Nothing
				'Dim letterPref as LetteringPreferences = Nothing
				'Dim symbolPref as SymbolPreferences = Nothing
				'Dim theAnnotationManager as NXOpen.Annotations.AnnotationManager = workPart.Annotations
 
				'lw.WriteLine("origin: " & noteDimOrigin.X & ", " & noteDimOrigin.Y)
				'letterPref = noteDim.GetLetteringPreferences()
				'symbolPref = theAnnotationManager.Preferences.GetSymbolPreferences()
 
				Dim nullAnnotations_IdSymbol As Annotations.IdSymbol = Nothing
				Dim idSymbolBuilder1 As Annotations.IdSymbolBuilder
 
				idSymbolBuilder1 = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(nullAnnotations_IdSymbol)
				idSymbolBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.XyPlane
				idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.Hexagon
				idSymbolBuilder1.UpperText = counter.ToString
				'use the symbol size set in the part
				idSymbolBuilder1.Size = .5
 
				Dim assocOrigin1 As Annotations.Annotation.AssociativeOriginData
				With assocOrigin1
					.OriginType = Annotations.AssociativeOriginType.OffsetFromText
					.OffsetAnnotation = myDimension
					.OffsetAlignmentPosition = Annotations.AlignmentPosition.TopLeft
					if myDimension.GetType().ToString() = "NXOpen.Annotations.Note" Then
						.XOffsetFactor = XOffsetNote
						.YOffsetFactor = YOffsetNote
					Else
						.XOffsetFactor = XOffsetDim
						.YOffsetFactor = YOffsetDim
					End if
				End With
				idSymbolBuilder1.Origin.SetAssociativeOrigin(assocOrigin1)
 
				Dim QC_IDSymbol As IDSymbol
				QC_IDSymbol = idSymbolBuilder1.Commit()
				'change IDSymbol layer to match that of the dimension or note it is attached to
				QC_IDSymbol.Layer = myDimension.Layer

Difficult to tell from the code posted. I would assume there is a loop somewhere in your code to apply the ID balloons to every dimension, but it is not shown in the code above. Also, don't forget to call the ID symbol builder's .Destroy method after the symbol is created. You will need to create, use, and destroy a symbol builder for each symbol that you create. Not calling the .Destroy method can lead to some strange results.

I am looping through all of the dimensions with

For Each myDimension As Annotations.Dimension In workPart.Dimensions

Do you think it's possible that the balloons are created but are not visible? Could you clarify which lines are assigning visibility to the balloon?

Thanks!

Are you creating an ID symbol builder object each time through the loop? If so, you also need to call the .Destroy method before the next loop iteration. Failing to do so may cause odd results.

If the inputs to the symbol builder are valid it will create a visible symbol when .Commit is called. You should not need to do anything special to make the symbol visible.

I've realized that the issue is that only the dimensions in the current sheet are ballooned, so when I go through each sheet individually and run the code, all of the dimensions are ballooned. However, I'm not sure why this is the case since I have a loop that goes through all of the dimensions in the workpart:

For Each myDimension As Annotations.Dimension In workPart.Dimensions

Does anyone know why this might be happening?

At a guess, I'd say that you can only create ID symbols on the currently active drawing sheet. If this is the case, you will need to switch the currently active sheet as needed in the journal code. A function to report the drawing sheet that contains a specific object can be found here:
http://nxjournaling.com/comment/1095#comment-1095

Thanks! Would you happen to know of any other workpart subclasses that might traverse the entire file, instead of just individual sheets? I'm currently using workpart.dimensions.

The .Dimensions collection does give you access to all of the dimensions in the part (not just those on the current sheet). My point was that you can only create new ID symbols on the current drawing sheet. The current drawing sheet is similar to the active layer in modeling; new geometry you create ends up on the work layer/active sheet.

My suggestion was to iterate through the dimensions, query which sheet the dimension is on, change the active sheet to the sheet that contains the dimension, and finally create the ID symbol. If you have many dimensions and/or sheets, you could sort the dimensions by sheet before creating the ID symbols. This would minimize the "sheet switching" and the related time delays.

Thanks! I will try doing this.

Also, would you happen to know if it is possible to fill the balloon with a color and make the font white? I couldn't seem to find an option for filling the balloon.

Thanks for all your help!

You can change the text color to any available color, but I don't know of a way to "fill in" the balloon.

I was able to get the code to cycle though all of the sheets for the balloons. Thanks!

Just curious - do you think it would be possible create a hyperlink between the excel output of dimensions and the balloons that they correspond to? I was hoping I could click on a dimension in the Excel and it could bring up/highlight the balloon on the drawing. If so, do you have any resources that might be a good starting point?

Off the top of my head, I can't think of an easy way to hyperlink the contents of an Excel cell to an NX drawing. But of course, this does not mean that it cannot be done.

Hi I reach to use you J of 01/28/2012, but not the next ones posted here, Im quite new in this, I need to make square symbol instead of triangle, we currently use GDT Symbols with appended text one by one in the dimensions... I think your J of 09/19/2013 is what I need but give me an error message... do you think is possible to have this with a box instead than baloon or triangle?

DBarrrero

To use a square symbol in the original journal, find the following line:

idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.TriangleUp

and change it to:

idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.Square

Thanks, just perfect.

DBarrrero

Sorry if this is a stupid question. How would one go about eliminating the auto X and Y offset placement and have the symbol placement by clicking the mouse.

After selecting a dimension, you could have the user select a position on the drawing (probably with the SpecifyScreenPosition method), calculate the offset from the dimension and use the calculated X and Y offsets instead of the hardcoded values.

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.UI
Imports NXOpen.Annotations

Module NXJournal
Sub Main

'*************************************************************************
'change the following offset distances to get something that works for you
'offsets from dimension text
Const XOffsetDim as Double = 0
Const YOffsetDim as Double = 2
'offsets from notes
Const XOffsetNote as Double = -3
Const YOffsetNote as Double = 0
'*************************************************************************

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim lw As ListingWindow = theSession.ListingWindow
Dim noteDim As Annotation
Dim noteDimOrigin as Point3D = Nothing
'Dim letterPref as LetteringPreferences = Nothing
Dim symbolPref as SymbolPreferences = Nothing
Dim noteNumber as Integer
Dim input as String
'Dim theAnnotationManager as NXOpen.Annotations.AnnotationManager = workPart.Annotations
Dim theAnnotationManager as AnnotationManager = workPart.Annotations

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Start")

Do
input = InputBox("Enter starting QC number: ", "QC inspection numbers", "1")
Loop Until (isNumeric(input))
noteNumber = input

'lw.Open()

While selectNoteDimension("Select Dimension or Note", noteDim) = Selection.Response.Ok
noteDimOrigin = noteDim.AnnotationOrigin
'lw.WriteLine("origin: " & noteDimOrigin.X & ", " & noteDimOrigin.Y)
'letterPref = noteDim.GetLetteringPreferences()
symbolPref = theAnnotationManager.Preferences.GetSymbolPreferences()
'lw.WriteLine("Alignment Position: " & letterPref.AlignmentPosition.ToString())
'lw.WriteLine("ID Symbol size: " & symbolPref.IDSymbolSize)
'lw.WriteLine("Annotation type: " & noteDim.GetType().ToString())

Dim nullAnnotations_IdSymbol As Annotations.IdSymbol = Nothing
Dim idSymbolBuilder1 As Annotations.IdSymbolBuilder

idSymbolBuilder1 = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(nullAnnotations_IdSymbol)
idSymbolBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.XyPlane
idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.TriangleUp
idSymbolBuilder1.UpperText = noteNumber
'use the symbol size set in the part
idSymbolBuilder1.Size = symbolPref.IDSymbolSize

Dim assocOrigin1 As Annotations.Annotation.AssociativeOriginData
With assocOrigin1
.OriginType = Annotations.AssociativeOriginType.OffsetFromText
.OffsetAnnotation = noteDim
.OffsetAlignmentPosition = Annotations.AlignmentPosition.TopLeft
if noteDim.GetType().ToString() = "NXOpen.Annotations.Note" Then
.XOffsetFactor = XOffsetNote
.YOffsetFactor = YOffsetNote
Else
.XOffsetFactor = XOffsetDim
.YOffsetFactor = YOffsetDim
End if
End With
idSymbolBuilder1.Origin.SetAssociativeOrigin(assocOrigin1)

Dim QC_IDSymbol As IDSymbol
QC_IDSymbol = idSymbolBuilder1.Commit()
'change IDSymbol layer to match that of the dimension or note it is attached to
QC_IDSymbol.Layer = noteDim.Layer
idSymbolBuilder1.Destroy()

noteNumber += 1

End While
'lw.Close
theSession.SetUndoMarkName(markId1, "Label Dimensions")
theSession.SetUndoMarkVisibility(markId1, Nothing, Session.MarkVisibility.Visible)

End Sub 'Main

'**************************************************
Function selectNoteDimension(ByVal prompt As String, ByRef obj As Annotation)
'Annotation class covers dimensions and notes
'Annotation -> Dimension
'Annotation -> DraftingAid -> SimpleDraftingAid -> NoteBase -> BaseNote -> Note
Dim ui As UI = GetUI()
Dim mask(1) As Selection.MaskTriple
With mask(0)
.Type = UFConstants.UF_dimension_type
.Subtype = 0
.SolidBodySubtype = 0
End With
With mask(1)
.Type = UFConstants.UF_drafting_entity_type
.Subtype = UFConstants.UF_draft_note_subtype
.SolidBodySubtype = 0
End With

Dim cursor As Point3d = Nothing

Dim resp As Selection.Response = _
ui.SelectionManager.SelectObject(prompt, prompt, _
Selection.SelectionScope.AnyInAssembly, _
Selection.SelectionAction.ClearAndEnableSpecific, _
False, False, mask, obj, cursor)

If resp = Selection.Response.ObjectSelected Or _
resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If
End Function 'selectNoteDimension
'**************************************************

End Module

I wouyld like to use the SpecifyScreenPosition as you suggested, but I am missing something. The above code will apply a QC balloon, but I cannot splice in the SpecifyScreenPosition function into this code. I do not have enough experience to complete this.