Regarding Zone location for dimensions in Nx drawings

' VB Script to extract all the dimensions in an NX part file to an MS Excel Spreadsheet.
' The details extracted are:

' Sheet No. | Zone | Balloon No. | Description\Measurement Direction | Nominal Value |
' Tolerance Type | Upper Tolerance | Lower Tolerance | Maximum Value | Minimum Value

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

Module ExportDimensionsAndAnnotations
'Declare global variables
Dim theSession as Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession

Sub Main()
' First read the active part file from NX.
' Then, loop through the sheets.
' Then, loop through the dimensions in the sheet
' Grab the zone, text, tolerance type, tolerance and the measurement direction for each.
' Grab the nearest annotation in that zone.
' Build an array or a dictionary (similar to JSON or Python's Dictionary class)
' Then, loop through the text in the document, and do the same steps, except for those that are inapplicable, of course.
' Ask for a savefile location.
' Create an Excel file in that location
' Open the Excel file.
' Write array to the excel file.

If IsNothing(theSession.Parts.Work) Then 'Error handling
MsgBox("This code requires an active part. Please open a drawing first and then try again.")
Exit Sub
End If
Dim workPart as Part
workPart = theSession.Parts.Work

Dim theUISession as UI = UI.getUI
Dim saveFileName as String
Dim saveDialog as New System.Windows.Forms.SaveFileDialog
Dim objExcel as Object
Dim objWorkbook as Object
Dim excelFileExists as Boolean = False
Dim objWorksheet as Object
Dim colSheetNumber as Integer = 1
Dim colZone as Integer = 2
Dim colBalloon as Integer = 3
Dim colDescrMatlDir as Integer = 4
Dim colNomValue as Integer = 5
Dim colTolerType as Integer = 6
Dim colTolerUpper as Integer = 7
Dim colTolerLower as Integer = 8
Dim colMaxValue as Integer = 9
Dim colMinValue as Integer = 10
Dim colComment As Integer = 11

Dim valueSheetNumber as String
Dim valueZone as String
Dim valueBalloon as String
Dim valueDescrMatlDir as String
Dim valueNomValue as String
Dim valueTolerType as String
Dim valueTolerUpper as String
Dim valueTolerLower as String
Dim valueMaxValue as String
Dim valueMinValue as String
Dim valueComment As String
Dim valueToler As String
Dim draftingFeatureControlFrameBuilder1 As Annotations.DraftingFeatureControlFrameBuilder

Dim rowNumber as Integer = 1

With saveDialog
.DefaultExt = "xlsx"
.FileName = "Exported Data"
.Filter = "MS Excel Spreadsheets (*.xlsx)|*.xlsx|All Files (*.*)|*.*"
.FilterIndex = 1
.OverwritePrompt = True
.Title = "Select a file where you'd like to save the exported data."
End With
saveDialog.ShowDialog()
saveFileName = saveDialog.FileName
If saveFileName ="Exported Data" Then
MsgBox("You failed to select a save file. Exitting the macro.")
Exit Sub
End If
objExcel = CreateObject("Excel.Application")
if objExcel is Nothing Then
theUISession.NXMessageBox.Show("Error", theUISession.NXMessageBox.DialogType.Error, "Could not start Excel, journal exiting")
Exit Sub
End If
If File.Exists(saveFileName) Then
excelFileExists = True
objWorkbook = objExcel.Workbooks.Open(saveFileName)
objWorksheet = objWorkbook.Sheets.Add
Else
objWorkbook = objExcel.Workbooks.Add
objWorkbook.saveAs(saveFileName)
objWorksheet = objWorkbook.Sheets(1)
End If

objWorksheet.cells(rowNumber, colSheetNumber).Value = "Sheet Number"
objWorksheet.cells(rowNumber, colZone).Value = "Drawing Zone"
objWorksheet.cells(rowNumber, colBalloon).Value = "Balloon Number"
objWorksheet.cells(rowNumber, colDescrMatlDir).Value = "Description Text \ Measurement Direction"
objWorksheet.cells(rowNumber, colNomValue).Value = "Nominal Value"
objWorksheet.cells(rowNumber, colTolerType).Value = "Tolerance Type"
objWorksheet.cells(rowNumber, colTolerUpper).Value = "Upper Tolerance"
objWorksheet.cells(rowNumber, colTolerLower).Value = "Lower Tolerance"
objWorksheet.cells(rowNumber, colMaxValue).Value = "Maximum Value"
objWorksheet.cells(rowNumber, colMinValue).Value = "Minimum Value"
objWorksheet.cells(rowNumber, colvalueToler).Value = "Tolerance"

Dim theSheet as Drawings.DrawingSheet
For Each tempDim as Annotations.Dimension in workPart.Dimensions
rowNumber = rowNumber + 1

theSheet = AskDrawingSheet(tempDim)
valueSheetNumber = getSheetNumber(theSheet).ToString
valueZone = getZone(theSheet, tempDim)
valueBalloon = ""
valueNomValue = tempDim.ComputedSize

valueDescrMatlDir = tempDim.GetType.ToString
' Clean up the material direction.
valueDescrMatlDir = Replace(valueDescrMatlDir, "NXOpen.Annotations.","")

valueTolerLower = ""
valueTolerUpper = ""
valueMaxValue = ""
valueMinValue = ""
valueComment = ""
valuetoler = "±"
Select Case valueDescrMatlDir
Case "DiameterDimension"
valueDescrMatlDir = "ø" & valueNomValue & valueToler
Case "CylindricalDimension"
valueDescrMatlDir = "ø" & valueNomValue & valueToler
Case "HoleDimension"
valueDescrMatlDir = "ø" & valueNomValue & valueToler
Case "MinorAngularDimension"
valueDescrMatlDir = "∠" & valueNomValue & valueToler
Case "HorizontalDimension"
valueDescrMatlDir = valueNomValue & valueToler
Case "VerticalDimension"
valueDescrMatlDir = valueNomValue & valueToler
End Select

valueTolerType = tempDim.ToleranceType.ToString
Select Case valueTolerType
Case Is = "UnilateralBelow"
valueTolerLower = tempDim.LowerMetricToleranceValue.ToString
valueMaxValue = tempDim.ComputedSize
valueMinValue = tempDim.ComputedSize + tempDim.LowerMetricToleranceValue
Case Is = "UnilateralAbove"
valueTolerUpper = tempDim.UpperMetricToleranceValue.ToString
valueMaxValue = tempDim.ComputedSize + tempDim.UpperMetricToleranceValue
valueMinValue = tempDim.ComputedSize
Case Is = "LimitsAndFits"
valueTolerLower = tempDim.LimitFitDeviation
valueTolerUpper = tempDim.LimitFitGrade
valueMaxValue = "As per standards"
valueMinValue = "As per standards"
Case Is = "BilateralOneLine"
valueTolerUpper = tempDim.UpperMetricToleranceValue.ToString
valueTolerLower = (-1 * tempDim.UpperMetricToleranceValue).ToString
valueMaxValue = tempDim.ComputedSize + tempDim.UpperMetricToleranceValue
valueMinValue = tempDim.ComputedSize - tempDim.UpperMetricToleranceValue
Case Is = "BilateralTwoLines"
valueTolerLower = tempDim.LowerMetricToleranceValue.ToString
valueTolerUpper = tempDim.UpperMetricToleranceValue.ToString
valueMaxValue = tempDim.ComputedSize + tempDim.UpperMetricToleranceValue
valueMinValue = tempDim.ComputedSize + tempDim.LowerMetricToleranceValue
Case Is = "None"
valueTolerUpper = "NA"
valueTolerLower = "NA"
valueMaxValue = tempDim.ComputedSize
valueMinValue = tempDim.ComputedSize

Case Is = "Basic"
valueTolerUpper = "NA"
valueTolerLower = "NA"
valueMaxValue = tempDim.ComputedSize
valueMinValue = tempDim.ComputedSize
Case Is = "LimitOneLine"
valueTolerUpper = tempDim.UpperMetricToleranceValue.ToString
valueTolerLower = tempDim.LowerMetricToleranceValue.ToString
valueMaxValue = tempDim.ComputedSize + tempDim.UpperMetricToleranceValue
valueMinValue = tempDim.ComputedSize + tempDim.LowerMetricToleranceValue
Case Else
valueComment = "Error, " & valueTolerType & " is a tolerance type that hasn't been accounted for in the code. Please modify the script."
End Select

objWorksheet.cells(rowNumber, colSheetNumber).Value = valueSheetNumber
objWorksheet.cells(rowNumber, colZone).Value = valueZone
objWorksheet.cells(rowNumber, colBalloon).Value = valueBalloon
objWorksheet.cells(rowNumber, colDescrMatlDir).Value = valueDescrMatlDir
objWorksheet.cells(rowNumber, colNomValue).Value = valueNomValue
objWorksheet.cells(rowNumber, colTolerType).Value = valueTolerType
objWorksheet.cells(rowNumber, colTolerUpper).Value = valueTolerUpper
objWorksheet.cells(rowNumber, colTolerLower).Value = valueTolerLower
objWorksheet.cells(rowNumber, colMaxValue).Value = valueMaxValue
objWorksheet.cells(rowNumber, colMinValue).Value = valueMinValue
objWorksheet.cells(rowNumber, colComment).Value = valueComment
Next

For Each temp As Annotations.Gdt In workPart.Gdts
If TypeOf (temp) Is Annotations.DraftingFcf Then
rowNumber = rowNumber + 1
theSheet = AskDrawingSheet(temp)
valueSheetNumber = getSheetNumber(theSheet)
objWorksheet.cells(rowNumber, colSheetNumber).Value = valueSheetNumber
objWorksheet.cells(rowNumber, colZone).Value = getZone(theSheet, temp)
Dim fcfBuilder As Annotations.DraftingFeatureControlFrameBuilder
fcfBuilder = workPart.Annotations.CreateDraftingFeatureControlFrameBuilder(temp)
Dim featureControlFrameDataBuilder1 As Annotations.FeatureControlFrameDataBuilder = fcfBuilder.FeatureControlFrameDataList.FindItem(0)
objWorksheet.cells(rowNumber, colDescrMatlDir).Value = fcfBuilder.Characteristic.ToString & " (" & featureControlFrameDataBuilder1.ZoneShape.ToString & ") " & featureControlFrameDataBuilder1.ToleranceValue.ToString & " to " & featureControlFrameDataBuilder1.PrimaryDatumReference.Letter
' objWorksheet.cells(rowNumber, colNomValue).Value = "Zone Shape: " & featureControlFrameDataBuilder1.ZoneShape.ToString
' objWorksheet.cells(rowNumber, colTolerType).Value = "Geometric Tolerance: " & fcfBuilder.Characteristic.ToString

objWorksheet.cells(rowNumber, colMaxValue).Value = featureControlFrameDataBuilder1.ToleranceValue

fcfBuilder.Destroy()
Else
theSheet = AskDrawingSheet(temp)
valueSheetNumber = getSheetNumber(theSheet)
objWorksheet.cells(rowNumber, colSheetNumber).Value = valueSheetNumber
objWorksheet.cells(rowNumber, colZone).Value = getZone(theSheet, temp)
rowNumber = rowNumber + 1
objWorksheet.cells(rowNumber, colDescrMatlDir) = temp.Name().ToString
objExcel.Cells(rowNumber, colDescrMatlDir+1).Value = TypeName(temp).ToString
End If
Next

For Each surfacefinish As Annotations.DraftingSurfaceFinish in workPart.Annotations.DraftingSurfaceFinishSymbols 'DraftingViews
rowNumber+=1
Dim sfBuilder as NXOpen.Annotations.DraftingSurfaceFinishBuilder
sfBuilder = workPart.Annotations.DraftingSurfaceFinishSymbols.CreateDraftingSurfaceFinishBuilder(surfacefinish)
theSheet = AskDrawingSheet(surfacefinish)
valueSheetNumber = getSheetNumber(theSheet)
objWorksheet.cells(rowNumber, colSheetNumber).Value = valueSheetNumber
objWorksheet.cells(rowNumber, colZone).Value = getZone(theSheet, surfacefinish)
objExcel.Cells(rowNumber, colDescrMatlDir).Value = "Surface Finish"
objExcel.Cells(rowNumber, colTolerType).Value = surfacefinish.getTolerance().ToleranceType.ToString
objExcel.Cells(rowNumber, colMaxValue).Value = Replace(sfBuilder.A1, ",", ".")
Next

' For Each annotatednote as Annotations.Note in workPart.Notes
' rowNumber = rowNumber + 1
' objExcel.Cells(rowNumber, colDescrMatlDir).Value = TypeName(annotatednote)
' objExcel.Cells(rowNumber, colComment).Value = annotatednote.getText()
' Next
Dim pmi_manager as NXOpen.Annotations.PmiManager = workPart.PmiManager()
For Each pmi_attrib as NxOpen.Annotations.PmiAttribute in pmi_manager.PmiAttributes
rowNumber = rowNumber + 1
objExcel.cells(rowNumber, colDescrMatlDir).Value = TypeName(pmi_attrib)
Next

Dim myIdBuilder As Annotations.IdSymbolBuilder
For Each tempID As Annotations.IdSymbol In workPart.Annotations.IdSymbols
' rowNumber = rowNumber + 1
myIdBuilder = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(tempID)
Dim idValue as String = myIdBuilder.UpperText
Select Case idValue.Length
Case 1
idValue = "0000" & idValue
Case 2
idValue = "000" & idValue
Case 3
idValue = "00" & idValue
Case 4
idValue = "0" & idValue
End Select
theSheet = AskDrawingSheet(tempID)
valueSheetNumber = getSheetNumber(theSheet)
valueZone = getZone(theSheet, tempID)
' objWorksheet.cells(rowNumber, colSheetNumber).Value = valueSheetNumber
Dim i as integer
Dim zone_value as String
Dim sheet_value as String
Dim preexistingballoonvalue as String

for i = 1 to rowNumber
zone_value = objWorksheet.cells(i, colZone).Value
sheet_value = objWorksheet.cells(i, colSheetNumber).Value

If (zone_value = valueZone) AND (sheet_value = valueSheetNumber) Then
preexistingballoonvalue = objWorksheet.cells(i, colBalloon).Value

If preexistingballoonvalue <> "" Then
Select Case preexistingballoonvalue.Length
Case 1
preexistingballoonvalue = "0000" & preexistingballoonvalue
Case 2
preexistingballoonvalue = "000" & preexistingballoonvalue
Case 3
preexistingballoonvalue = "00" & preexistingballoonvalue
Case 4
preexistingballoonvalue = "0" & preexistingballoonvalue
End Select
objWorksheet.cells(i, colBalloon).Value = preexistingballoonvalue & " OR " & idValue
With objWorksheet.cells(i, colBalloon).Interior
.Color = 255
End With
' With Selection.Interior
' .Pattern = xlNone
' .TintAndShade = 0
' .PatternTintAndShade = 0
' End With
Else
objWorksheet.cells(i, colBalloon).Value = idValue
objWorksheet.cells(i, colBalloon).NumberFormat = "00000"
End If
End If
Next i
' objWorksheet.cells(rowNumber, colBalloon).Value = idValue
' objWorksheet.cells(rowNumber, colSheetNumber).Value = "origin: " & myIdBuilder.Origin.OriginPoint.ToString
' objWorksheet.cells(rowNumber, 3).Value = "style: " & myIdBuilder.Type.ToString
' objWorksheet.cells(rowNumber, 4).Value = "size: " & myIdBuilder.Size.ToString
' objWorksheet.cells(rowNumber, 5).Value = "arrow type: " & tempID.GetLineAndArrowPreferences.FirstArrowType.ToString
' objWorksheet.cells(rowNumber, 6).Value = "stub length: " & tempID.GetLineAndArrowPreferences.StubLength.ToString

Next

' rowNumber = rowNumber + 1
' objWorksheet.cells(rowNumber, 1).Value = "End."
objWorksheet.Columns("A:M").EntireColumn.AutoFit
objWorkbook.save()
objWorkbook.close()
objExcel.Quit()
objWorksheet = Nothing
objWorkbook = Nothing
objExcel = Nothing
MsgBox("Completed the extraction successfully! Check " & saveFileName & " for the data.")

End Sub

Function getSheetNumber(ByVal theSheet as Drawings.DrawingSheet) As String
' This function returns the number of a sheet given the DrawingSheet object.
Dim sheetNum as Integer
Dim theSheetBuilder as Drawings.DrawingSheetBuilder
theSheetBuilder = theSession.Parts.Work.DrawingSheets.DrawingSheetBuilder(theSheet)
sheetNum = theSheetBuilder.Number
theSheetBuilder.Destroy()
Return sheetNum.ToString
End Function

Function AskDrawingSheet(ByVal theObject As TaggedObject) As Drawings.DrawingSheet
Dim theView As View = TryCast(theObject, View)
If Not theView Is Nothing Then
Dim sheetTag As Tag = Nothing
Try
theUfSession.Draw.AskDrawingOfView(theView.Tag, sheetTag)
Return Utilities.NXObjectManager.Get(sheetTag) ' the drawing it is on
Catch ex As NXException
Return Nothing ' it is a model view
End Try
End If

Dim viewName As String = Nothing
Dim status As Integer = Nothing
Try
theUfSession.View.AskViewDependentStatus(theObject.Tag, status, viewName)
Catch ex As NXException
Return Nothing
End Try
If status = 0 Then Return Nothing ' it is a model mode object

Dim viewTag As Tag = Nothing
theUfSession.View.AskTagOfViewName(viewName, viewTag)
Dim viewType As Integer = Nothing
Dim viewSubtype As Integer = Nothing
theUfSession.View.AskType(viewTag, viewType, viewSubtype)
If viewType = 0 Then Return Nothing ' it is view dependent in a modeling view

Dim drawingTag As Tag = Nothing
theUfSession.Draw.AskDrawingOfView(viewTag, drawingTag)
Return Utilities.NXObjectManager.Get(drawingTag) ' the drawing it is on!

End Function

Function getZone(ByVal theSheet As Drawings.DrawingSheet, ByVal theAnnotation As Annotations.Annotation) As String
Dim borderBuilder As Drawings.BordersAndZonesBuilder
borderBuilder = theSession.Parts.Work.Drafting.BordersAndZonesObjects.CreateBordersAndZonesBuilder(theSheet.BordersAndZones)

Dim numHorizontalZones As Integer = (theSheet.Length - borderBuilder.RightMargin - borderBuilder.LeftMargin) / borderBuilder.HorizontalSize
Dim numVerticalZones As Integer = (theSheet.Height - borderBuilder.BottomMargin - borderBuilder.TopMargin) / borderBuilder.VerticalSize

'calculate zone wrt bottom left of drawing (ZoneOrigin.BottomRight)
Dim Hcell As Double = (theAnnotation.AnnotationOrigin.X - borderBuilder.LeftMargin) / borderBuilder.HorizontalSize
Dim Vcell As Double = (theAnnotation.AnnotationOrigin.Y - borderBuilder.BottomMargin) / borderBuilder.VerticalSize

Hcell = Math.Ceiling(Hcell)
Vcell = Math.Ceiling(Vcell)

Dim theZoneOrigin As Drawings.BordersAndZonesBuilder.ZoneOrigin = borderBuilder.Origin
borderBuilder.Destroy()

Dim verticalLetterNum As Integer
Dim verticalLetter As Char

Dim horizontalNum As Integer

If theZoneOrigin = Drawings.BordersAndZonesBuilder.ZoneOrigin.BottomLeft Or theZoneOrigin = Drawings.BordersAndZonesBuilder.ZoneOrigin.BottomRight Then
horizontalNum = Hcell
Else
'origin on left side
horizontalNum = numHorizontalZones - Hcell + 1
End If

If theZoneOrigin = Drawings.BordersAndZonesBuilder.ZoneOrigin.TopLeft Or theZoneOrigin = Drawings.BordersAndZonesBuilder.ZoneOrigin.TopRight Then
verticalLetterNum = Asc("A") + Vcell - 1
verticalLetter = Chr(verticalLetterNum)

Else
'origin on the top
verticalLetterNum = Asc("A") + numVerticalZones - Vcell
verticalLetter = Chr(verticalLetterNum)

End If
Return verticalLetter & horizontalNum.ToString
End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer
'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
'-------------------------------
End Function
End Module