Break dimension extension lines

'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

' 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