Break dimension extension lines

Hi,
thanks for your effort. I took this journal as a base and modificated it to cycle through all dimensions and look for intersections with the other dimensions. So this will work with no user interaction and the user does not have to find the dimensions.

'NXJournaling.com
'May 23, 2013
'tested on NX 8
'
'based on code from https://bbs.industrysoftware.automation.siemens.com/vbulletin/showthread.php?t=52025
'posted by user "rossobryan" (Clayton)
'
'add gaps to dimension extension lines (vertical and horizontal dimensions only in this version)
'Journal prompts user to select 2 dimensions. If dimension extension lines intersect,
'a gap symbol is added to the first selected dimension. Journal loops until user presses "Cancel".
'The gap symbols are not associative to the intersection of the extension lines.
'If one of the dimensions moves, the gap can be moved or deleted by using Edit -> component;
'select the dimension that the gap symbol is applied to, the cursor will then change to a
'"point selection" type cross, click on the location of the gap symbol and press Apply or OK.
'Alternately, the gap can be deleted by toggling the extension line off then back on. Right click the
'dimension and choose Style -> Dimensions, toggle the extension line off, press Apply, toggle the line
'on, and press Apply or OK.

'June 6, 2014
'Updated to work with most dimension types (any dimension that has extension lines).
'Additional error handling, various code simplifications/tweaks.
'tested with NX 8.5

Option Strict Off
Imports System
Imports System.Windows.Forms
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF

Module ExtensionLineBreak_2

Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession
Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow

'%%%%% change the break symbol size to your liking
Const inchSymbolLength = 0.1
Const inchSymbolHeight = 0.1
Const mmSymbolLength = 2.5
Const mmSymbolHeight = 2.5
'%%%%%

Dim myExtensionLines As New List(Of Line)

Sub Main()

Dim dim1ExtensionLines As New List(Of Line)
Dim dim2ExtensionLines As New List(Of Line)

Dim undoStack As New Stack(Of Session.UndoMarkId)

lw.Open()

Dim myDim1 As Annotations.Dimension
Dim myDim2 As Annotations.Dimension
Dim keepGoing As Boolean = True
Dim allDimensions() As Annotations.Dimension = workPart.Dimensions.ToArray()
Dim a As Integer = 0
Dim b As Integer = 0
Dim markId1 As Session.UndoMarkId
Dim markText As String = "Break Dimension Line"
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, markText)

'undoStack.Push(markId1)

For a = 0 To allDimensions.Length - 1

Try
GetExtensionLines(allDimensions(a), dim1ExtensionLines)

Catch ex As Exception

'Dim myUndo As Session.UndoMarkId = undoStack.Pop
'theSession.UndoToMark(myUndo, markText)
'theSession.DeleteUndoMark(myUndo, markText)

If ex.Message = "Dimension has no extension lines" Then
MessageBox.Show("The selected dimension has no extension lines, please choose new dimensions or press Cancel", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Continue For
Else
'lw.WriteLine("Error: " & ex.Message)
MessageBox.Show("An unexpected error has occurred, the journal will now exit", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
End If

End Try

For b = a + 1 To allDimensions.Length - 1

If a = b Then Continue For

Try
GetExtensionLines(allDimensions(b), dim2ExtensionLines)

Catch ex As Exception

'Dim myUndo As Session.UndoMarkId = undoStack.Pop
'theSession.UndoToMark(myUndo, markText)
'theSession.DeleteUndoMark(myUndo, markText)

If ex.Message = "Dimension has no extension lines" Then
MessageBox.Show("The selected dimension has no extension lines, please choose new dimensions or press Cancel", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Continue For
Else
'lw.WriteLine("Error: " & ex.Message)
MessageBox.Show("An unexpected error has occurred, the journal will now exit", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
End If

End Try

Try
CreateIntersectionPoints(allDimensions(a), dim1ExtensionLines, dim2ExtensionLines)

Catch ex As Exception
'lw.WriteLine("Error: " & ex.Message)
'Dim myUndo As Session.UndoMarkId = undoStack.Pop
'theSession.UndoToMark(myUndo, markText)
'theSession.DeleteUndoMark(myUndo, markText)

Finally
DeleteTempLines(dim1ExtensionLines)
DeleteTempLines(dim2ExtensionLines)
dim1ExtensionLines.Clear()
dim2ExtensionLines.Clear()

End Try
Next b
Next a

DeleteTempLines(dim1ExtensionLines)
DeleteTempLines(dim2ExtensionLines)
dim1ExtensionLines.Clear()
dim2ExtensionLines.Clear()

' While keepGoing
'
' Dim markId1 As Session.UndoMarkId
' Dim markText As String = "Break Dimension Line"
' markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, markText)
'
' undoStack.Push(markId1)
'
' 'select dim 1
' If SelectDimension("Select first dimension", myDim1) = Selection.Response.Cancel Then
' keepGoing = False
' Dim myUndo As Session.UndoMarkId = undoStack.Pop
' theSession.UndoToMark(myUndo, markText)
' theSession.DeleteUndoMark(myUndo, markText)
' Return
' End If
'
' Try
' GetExtensionLines(myDim1, dim1ExtensionLines)
'
' Catch ex As Exception
'
' Dim myUndo As Session.UndoMarkId = undoStack.Pop
' theSession.UndoToMark(myUndo, markText)
' theSession.DeleteUndoMark(myUndo, markText)
'
' If ex.Message = "Dimension has no extension lines" Then
' MessageBox.Show("The selected dimension has no extension lines, please choose new dimensions or press Cancel", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning)
' Continue While
' Else
' 'lw.WriteLine("Error: " & ex.Message)
' MessageBox.Show("An unexpected error has occurred, the journal will now exit", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
' Return
' End If
'
' End Try
'
' 'select dim 2
' If SelectDimension("Select second dimension", myDim2) = Selection.Response.Cancel Then
'
' keepGoing = False
' Dim myUndo As Session.UndoMarkId = undoStack.Pop
' theSession.UndoToMark(myUndo, markText)
' theSession.DeleteUndoMark(myUndo, markText)
' Return
'
' End If
'
' Try
' GetExtensionLines(myDim2, dim2ExtensionLines)
'
' Catch ex As Exception
'
' DeleteTempLines(dim1ExtensionLines)
' dim1ExtensionLines.Clear()
'
' Dim myUndo As Session.UndoMarkId = undoStack.Pop
' theSession.UndoToMark(myUndo, markText)
' theSession.DeleteUndoMark(myUndo, markText)
'
' If ex.Message = "Dimension has no extension lines" Then
' MessageBox.Show("The selected dimension has no extension lines, please choose new dimensions or press Cancel", "Warning", MessageBoxButtons.OK, MessageBoxIcon.Warning)
' Continue While
' Else
' MessageBox.Show("An unexpected error has occurred, the journal will now exit", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
' Return
' End If
'
' End Try
'
' 'create break symbol in first selected dimension
' Try
' CreateIntersectionPoints(myDim1, dim1ExtensionLines, dim2ExtensionLines)
'
' Catch ex As Exception
' lw.WriteLine("Error: " & ex.Message)
' Dim myUndo As Session.UndoMarkId = undoStack.Pop
' theSession.UndoToMark(myUndo, markText)
' theSession.DeleteUndoMark(myUndo, markText)
'
' Finally
' DeleteTempLines(dim1ExtensionLines)
' DeleteTempLines(dim2ExtensionLines)
' dim1ExtensionLines.Clear()
' dim2ExtensionLines.Clear()
'
' End Try
'
' End While

End Sub

Function SelectDimension(ByVal prompt As String, ByRef selObj As TaggedObject) As Selection.Response

Dim theUI As UI = UI.GetUI
Dim title As String = "Select a dimension"
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_dimension_type
.Subtype = UFConstants.UF_all_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
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

Sub GetExtensionLines(ByVal tempDim As Annotations.Dimension, ByRef extLines As List(Of Line))

Dim extLine As Line
Dim startPt As Point3d
Dim endPt As Point3d

'search mask {line data, arc data, text data, arrow data}
Dim searchMask() As Integer = {1, 0, 0, 0}
Dim cycleFlag As Integer = 0
Dim theAnnData(9) As Integer
Dim theAnnDataType As Integer
'annotation data type
'0 = no more data of requested types
'1 = line
'2 = arc
'3 = text
'4 = arrow
Dim theAnnDataForm As Integer
Dim numSegments As Integer
Dim theAnnOrigin(1) As Double
Dim radiusAngle As Double
Dim endPoints(3) As Double

Dim segNum As Integer = 1

Do
ufs.Drf.AskAnnData(tempDim.Tag, searchMask, cycleFlag, theAnnData, theAnnDataType, theAnnDataForm, numSegments, theAnnOrigin, radiusAngle)
If theAnnDataType = 0 Then
'lw.WriteLine("no more objects of specified type")
Exit Do
End If

'lw.WriteLine("data type: " & theAnnDataType.ToString)
'lw.WriteLine("data form: " & theAnnDataForm.ToString)
'lw.WriteLine("number of segments: " & numSegments.ToString)

'lw.WriteLine("")

If theAnnDataForm = 3 Then
'extension line
ufs.Drf.AskAnnLineSegEnds(segNum, theAnnData, endPoints)
'lw.WriteLine("extension line start point: " & endPoints(0) & ", " & endPoints(1))
'lw.WriteLine("extension line end point: " & endPoints(2) & ", " & endPoints(3))
'lw.WriteLine("")

startPt.X = endPoints(0)
startPt.Y = endPoints(1)
endPt.X = endPoints(2)
endPt.Y = endPoints(3)
extLine = workPart.Curves.CreateLine(startPt, endPt)
extLines.Add(extLine)

End If

Loop Until cycleFlag = 0

If extLines.Count = 0 Then
Throw New ApplicationException("Dimension has no extension lines")
End If

End Sub

Function intersectionLineLine(ByVal line1 As Line, ByVal line2 As Line) As Point

'line segment intersection test reference:
'http://www-cs.ccny.cuny.edu/~wolberg/capstone/intersection/Intersection%20point%20of%20two%20lines.html

Dim myModelingTolerance As Double
ufs.Modl.AskDistanceTolerance(myModelingTolerance)
'lw.WriteLine("modeling tolerance: " & myModelingTolerance.ToString)

Dim x1 As Double = line1.StartPoint.X
Dim x2 As Double = line1.EndPoint.X
Dim x3 As Double = line2.StartPoint.X
Dim x4 As Double = line2.EndPoint.X
Dim y1 As Double = line1.StartPoint.Y
Dim y2 As Double = line1.EndPoint.Y
Dim y3 As Double = line2.StartPoint.Y
Dim y4 As Double = line2.EndPoint.Y

Dim ua As Double
Dim ub As Double

Dim intPt As Point3d

Dim denom As Double
denom = ((y4 - y3) * (x2 - x1)) - ((x4 - x3) * (y2 - y1))
'lw.WriteLine("denom: " & denom.ToString)

If Math.Abs(denom) < myModelingTolerance Then
'lines are parallel or nearly parallel
'lw.WriteLine("lines parallel or nearly parallel")
Return Nothing
End If

ua = (((x4 - x3) * (y1 - y3)) - ((y4 - y3) * (x1 - x3))) / denom
ub = (((x2 - x1) * (y1 - y3)) - ((y2 - y1) * (x1 - x3))) / denom

If (ua > 0 And ua < 1) And (ub > 0 And ub < 1) Then

intPt.X = x1 + ua * (x2 - x1)
intPt.Y = y1 + ua * (y2 - y1)
intPt.Z = 0

'lw.WriteLine("intPt: " & intPt.ToString)

Dim retPt As Point = workPart.Points.CreatePoint(intPt)
Return retPt

Else
'no intersection on the line segments
'lw.WriteLine("no intersection on line segments")
Return Nothing
End If

End Function

Sub CreateIntersectionPoints(ByVal theDim As Annotations.Dimension, _
ByVal extLines1 As List(Of Line), _
ByVal extLines2 As List(Of Line))

Dim i As Integer
Dim j As Integer
Dim breakPt As Point
Dim offsetPt As Point
Dim angle As Double
Dim dimsIntersect As Boolean = False
Dim offsetDirection As Integer

Dim symbolLength As Double
If workPart.PartUnits = BasePart.Units.Millimeters Then
symbolLength = mmSymbolLength
Else
symbolLength = inchSymbolLength
End If

Dim distScalar As Scalar
distScalar = workPart.Scalars.CreateScalar(symbolLength * 0.5, Scalar.DimensionalityType.Length, SmartObject.UpdateOption.WithinModeling)

For i = 0 To extLines1.Count - 1
For j = 0 To extLines2.Count - 1
breakPt = Nothing
breakPt = intersectionLineLine(extLines1.Item(i), extLines2.Item(j))
If Not breakPt Is Nothing Then
dimsIntersect = True
angle = Math.Atan2(extLines1.Item(i).EndPoint.Y - extLines1.Item(i).StartPoint.Y, extLines1.Item(i).EndPoint.X - extLines1.Item(i).StartPoint.X)
angle = (angle * 180) / Math.PI

'normalize the angle
If angle < 0 Then
angle += 360
End If

'gap location changes slightly based on the angle of the extension line
'lines in quadrant 1 & 4 need to be shifted in (toward start point of extension line)
'lines in quadrant 2 & 3 need to be shiften out (toward end point of extension line)
If angle > 270 Or angle <= 90 Then
'line is somewhere in quadrant 1 or 4, shift break point toward start point of line
offsetDirection = Sense.Reverse
Else
'line is somewhere in quadrant 2 or 3, shift break point toward end point of line
offsetDirection = Sense.Forward
End If

'offset breakpoint 1/2 gap width
offsetPt = breakPt
breakPt = workPart.Points.CreatePoint(extLines1.Item(i), offsetPt, distScalar, PointCollection.AlongCurveOption.Distance, offsetDirection, SmartObject.UpdateOption.WithinModeling)

'breakPt.SetVisibility(SmartObject.VisibilityOption.Visible)
BreakDim(theDim, breakPt)

End If
Next
Next

If Not dimsIntersect Then
Throw New ApplicationException("Dim extension lines do not intersect")
End If

End Sub

Sub BreakDim(ByVal theDim As Annotations.Dimension, ByVal thePoint As Point)

Dim myDimLinePrefs As Annotations.LineAndArrowPreferences
myDimLinePrefs = theDim.GetLineAndArrowPreferences

Dim breakLocation As Point3d = thePoint.Coordinates

' Create the symbol
ufs.Drf.SetUgdefaultSbfFile()

Dim symbol_data As UFDrf.SymbolCreateData
ufs.Drf.InitSymbolCreateData(symbol_data)

If workPart.PartUnits = BasePart.Units.Millimeters Then
symbol_data.length = mmSymbolLength
symbol_data.height = mmSymbolHeight
Else
symbol_data.length = inchSymbolLength
symbol_data.height = inchSymbolHeight
End If

symbol_data.angle = 0

Dim anchor As Point = workPart.Points.CreatePoint(breakLocation)
symbol_data.anchor_tag = anchor.Tag
symbol_data.symbol_name = "GAP25"

Dim symbol_tag As Tag
ufs.Drf.PlaceSymbol(symbol_data, False, False, symbol_tag)

ufs.Drf.AddSymbolToObject(symbol_data, theDim.Tag)

End Sub

Sub DeleteTempLines(ByVal extLines As List(Of Line))

'delete temp lines
Try
Dim markId2 As Session.UndoMarkId
markId2 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Delete")

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(extLines.ToArray)

Dim notifyOnDelete2 As Boolean
notifyOnDelete2 = theSession.Preferences.Modeling.NotifyOnDelete

Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId2)

Catch ex As NXException
lw.WriteLine(ex.Message)
End Try

End Sub

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

only roughly tested but should work...

Hi,
I have used the modified program of Break dimension extension lines, but it has given me the error that "selected dimension has no extension lines, please choose another dimensions or press cancel". Please help me in get i trun properly on my system. I am using NX7.5 version of ungraphics.

Thanks

The modification of this journal falls over if the drawing contains thickness dimensions (tested in 8.5)

I got help from Mathias Maathz of GTAC. The clue is that you have to cycle through the dimensions to access the symbols which are attached to them. Mathias' sample code is found in GTAC document nx_api6068 but it is written in C#.

Below is the VB code that I've written. It doesn't work in NX10, but has been succesfully tested in NX11 and NX12.

' This program removes all the gap symbols found on dimensions in the work part.
' It doesn't work in NX10 but it does work in NX11.
Option Strict Off

Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Utilities

Module DeleteGapSymbols

Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()

Sub Main()

' The undo mark is necessary for the session update
Dim markId1 As Session.UndoMarkId = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Delete gap symbols")

Dim candidate As NXOpen.Tag = NXOpen.Tag.Null

Do
' Cycle throught the work part to find all the dimensions
ufs.Obj.CycleObjsInPart(theSession.Parts.Work.Tag, UFConstants.UF_dimension_type, candidate)
If (candidate <> NXOpen.Tag.Null) Then

Dim numSymbolFonts As Integer = Nothing
Dim symbolFontTags(50) As Tag

' For each dimension ask which symbol(s) are used on it
ufs.Drf.AskSymbolsUsed(candidate, numSymbolFonts, symbolFontTags)

Dim symbolName As String = Nothing
Dim numStrokes As Integer = 0
Dim strokeInfo As UFDrf.StrokeInfo() = Nothing

' With the tag of each symbol get its name
For i As Integer = 0 To numSymbolFonts - 1 Step 1
ufs.Drf.AskEmbeddedUdsFontInfo(symbolFontTags(i), symbolName, numStrokes, strokeInfo)

' If the symbol in one of the gaps then add it to the delete list
If symbolName.Contains("GAP06") Then
theSession.UpdateManager.AddToDeleteList(NXObjectManager.Get(symbolFontTags(i)))
ElseIf symbolName.Contains("GAP125") Then
theSession.UpdateManager.AddToDeleteList(NXObjectManager.Get(symbolFontTags(i)))
ElseIf symbolName.Contains("GAP25") Then
theSession.UpdateManager.AddToDeleteList(NXObjectManager.Get(symbolFontTags(i)))
End If

Next
End If
Loop Until candidate = NXOpen.Tag.Null

' Update the session
theSession.UpdateManager.DoUpdate(markId1)
End Sub

Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function

End Module