Update drawing (views, dimensions and annotations) to drafting standard. Delete named Title Block group. - Finished Code

I'm posting finished code which updates current drafting view to Drafting Standard (named ISO_NX11_LDM) and deletes Title Block group (by its name A4_LDM for example). It deletes empty groups too.

Could be helpful to someone. I'm mech not software engineer so it's nowhere close to elegant and tidy:)


'NXJournaling.com
'tested with NX 11.0
'17/09/18
'Updates drawing with drafting standards. That means views, dimensions and drafting entities.
'Deletes empty Groups and Title Block Groups like A4_LDM etc.
Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Imports System.Collections.Generic

Module dimensions_to_standard
Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim theUfSession As UFSession = UFSession.GetUFSession
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim lw As ListingWindow = theSession.ListingWindow

Sub Main()
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing

'CURRENT SHEET
Dim currentSheet As Drawings.DrawingSheet = theSession.Parts.Work.DrawingSheets.CurrentDrawingSheet
lw.Open()
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")

'Dim smazani Groups
Dim tmpGrp As NXOpen.Tag = NXOpen.Tag.Null
Dim myGroup As Group
Dim groupsToDelete As New List(Of Group)
Dim numMembers As Integer
Dim memberTags() As Tag

'lw.Writeline("current sheet Tag" & currentSheet.Tag)

'nacteni drafting standards
Dim loadDraftingStandardBuilder1 As NXOpen.Preferences.LoadDraftingStandardBuilder = Nothing
loadDraftingStandardBuilder1 = workPart.Preferences.DraftingPreference.CreateLoadDraftingStandardBuilder()
loadDraftingStandardBuilder1.WelcomeMode = False
loadDraftingStandardBuilder1.Level = NXOpen.Preferences.LoadDraftingStandardBuilder.LoadLevel.Site
loadDraftingStandardBuilder1.Name = "ISO_NX11_LDM"
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = loadDraftingStandardBuilder1.Commit()
loadDraftingStandardBuilder1.Destroy()

'smazani GROUPS prazdnych
Do
theUfSession.Obj.CycleObjsInPart(workPart.Tag, UFConstants.UF_group_type, tmpGrp)
'skip the initial null tag
If tmpGrp = NXOpen.Tag.Null Then
Continue Do
End If

myGroup = Utilities.NXObjectManager.Get(tmpGrp)

theUfSession.Group.AskGroupData(myGroup.Tag, memberTags, numMembers)

Dim myTaggedObj As TaggedObject ' = Utilities.NXObjectManager.Get(memberTags(1))
Dim symbolSheet As Drawings.DrawingSheet

If numMembers = 0 Then
groupsToDelete.Add(myGroup)
End If
Loop Until tmpGrp = NXOpen.Tag.Null

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(groupsToDelete.ToArray)
Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
groupsToDelete.Clear()

'smazani GROUPS
Dim response As String
response = InputBox("If there's message: NXOpen.NXException No view exists with specified name, use NO", "Delete titleblock? A/N", "A", 500, 500)
If response = "A" Then

Do
theUfSession.Obj.CycleObjsInPart(workPart.Tag, UFConstants.UF_group_type, tmpGrp)
'skip the initial null tag
If tmpGrp = NXOpen.Tag.Null Then
Continue Do
End If

myGroup = Utilities.NXObjectManager.Get(tmpGrp)

If (myGroup.Name = "A4_LDM") Or (myGroup.Name = "A3_LDM") Or (myGroup.Name = "A2_LDM") Or (myGroup.Name = "A1_LDM") Or (myGroup.Name = "A0_LDM") Or (myGroup.Name = "RAZITKO_LDM") Then

memberTags = Nothing
theUfSession.Group.AskGroupData(myGroup.Tag, memberTags, numMembers)

Dim myTaggedObj As TaggedObject ' = Utilities.NXObjectManager.Get(memberTags(1))
Dim symbolSheet As Drawings.DrawingSheet

'lw.Writeline("nazev group" & myGroup.Name )
'lw.WriteLine("pocet memberu"& numMembers)
Dim i As Integer
For i = 0 To (memberTags.Length - 1)
'lw.WriteLine(""& i)
myTaggedObj = Utilities.NXObjectManager.Get(memberTags(i))
'lw.Writeline("type of tagged " & myTaggedObj.GetType.ToString)
'kontrola zda obsahuje nebo ne

If myTaggedObj.GetType.ToString <> "NXOpen.Group" Then
'lw.WriteLine("BINGO")
'lw.WriteLine("index" & i)
symbolSheet = AskDrawingSheet(Utilities.NXObjectManager.Get(memberTags(i)))
If currentSheet.Tag = symbolSheet.Tag Then
groupsToDelete.Add(myGroup)

End If
Exit For
End If

Next

End If

Loop Until tmpGrp = NXOpen.Tag.Null

Dim nErrs3 As Integer
nErrs3 = theSession.UpdateManager.AddToDeleteList(groupsToDelete.ToArray)
Dim nErrs4 As Integer
nErrs4 = theSession.UpdateManager.DoUpdate(markId1)
End If

'dimensions

Dim partDimensions() As Annotations.Dimension
partDimensions = workPart.Dimensions.ToArray
Dim partObject As Annotations.Dimension
If partDimensions.Length > 0 Then

For Each partObject In partDimensions
Dim symbolSheet As Drawings.DrawingSheet = AskDrawingSheet(partObject)
If currentSheet.Tag = symbolSheet.Tag Then
Dim objects1(0) As NXOpen.DisplayableObject
objects1(0) = partObject
Dim editSettingsBuilder1 As NXOpen.Annotations.EditSettingsBuilder = Nothing
editSettingsBuilder1 = workPart.SettingsManager.CreateAnnotationEditSettingsBuilder(objects1)
editSettingsBuilder1.InheritSettingsFromPreferences()
Dim nXObject2 As NXOpen.NXObject = Nothing
nXObject2 = editSettingsBuilder1.Commit()
editSettingsBuilder1.Destroy()

End If
Next

Else
MsgBox("There are no dimensions in the work part")
End If

'notes

'SYMBOLS CENTERLINES
Dim tmpObject As NXOpen.Tag = NXOpen.Tag.Null
Dim myObject As NXObject
Dim objectsToDelete As New List(Of NXObject)
'Dim numMembers As Integer
'Dim memberTags() As Tag
Do
theUfSession.Obj.CycleObjsInPart(workPart.Tag, UFConstants.UF_drafting_entity_type, tmpObject)
'skip the initial null tag
If tmpObject = NXOpen.Tag.Null Then
Continue Do
End If

myObject = Utilities.NXObjectManager.Get(tmpObject)
'If (myGroup.Name="A4_LDM") or (myGroup.Name="A3_LDM") or (myGroup.Name="A2_LDM") or (myGroup.Name="A1_LDM") or (myGroup.Name="A0_LDM") or (myGroup.Name="RAZITKO_LDM") Then

'theUfSession.Group.AskGroupData(myGroup.Tag, memberTags, numMembers)

'Dim myTaggedObj As TaggedObject' = Utilities.NXObjectManager.Get(memberTags(1))
Dim symbolSheet As Drawings.DrawingSheet
symbolSheet = AskDrawingSheet(Utilities.NXObjectManager.Get(myObject.Tag))
If currentSheet.Tag = symbolSheet.Tag Then
Dim objects1(0) As NXOpen.DisplayableObject
objects1(0) = myObject
Dim editSettingsBuilder1 As NXOpen.Annotations.EditSettingsBuilder = Nothing
editSettingsBuilder1 = workPart.SettingsManager.CreateAnnotationEditSettingsBuilder(objects1)
editSettingsBuilder1.InheritSettingsFromPreferences()
Dim nXObject2 As NXOpen.NXObject = Nothing
nXObject2 = editSettingsBuilder1.Commit()
editSettingsBuilder1.Destroy()
objectsToDelete.Add(myObject)
End If

'lw.Writeline("nazev group" & myGroup.Name )
'lw.WriteLine("pocet memberu"& numMembers)
'Dim i As Integer
'For i = 0 to (memberTags.Length-1)
'lw.WriteLine(""& i)
'myTaggedObj = Utilities.NXObjectManager.Get(memberTags(i))
'lw.Writeline("type of tagged " & myTaggedObj.GetType.ToString)
'kontrola zda obsahuje nebo ne

'lw.Writeline("type" & myObject.GetType.ToString)
'lw.WriteLine("BINGO")
'symbolSheet= AskDrawingSheet(Utilities.NXObjectManager.Get(myObject))
'If currentSheet.Tag=symbolSheet.Tag Then
' objectsToDelete.Add(myObject)
'End If

'Next

'End If

Loop Until tmpObject = NXOpen.Tag.Null
'theSession.UpdateManager.AddToDeleteList(objectsToDelete.ToArray)
'theSession.UpdateManager.DoUpdate(markId1)

'DRAWING VIEWS
'Dim partObjects As NXOpen.Drawings.DraftingView

Dim view(0) As NXOpen.View
For Each sheet As Drawings.DrawingSheet In workPart.DrawingSheets
For Each view(0) In sheet.SheetDraftingViews
Dim symbolSheet As Drawings.DrawingSheet = AskDrawingSheet(view(0))
'lw.WriteLine("current" & currentSheet.Tag)
'lw.WriteLine("actual" & symbolSheet.Tag)
If currentSheet.Tag = symbolSheet.Tag Then
Dim editViewSettingsBuilder1 As NXOpen.Drawings.EditViewSettingsBuilder = Nothing
editViewSettingsBuilder1 = workPart.SettingsManager.CreateDrawingEditViewSettingsBuilder(view)

Dim editsettingsbuilders1(0) As NXOpen.Drafting.BaseEditSettingsBuilder
editsettingsbuilders1(0) = editViewSettingsBuilder1
workPart.SettingsManager.ProcessForMultipleObjectsSettings(editsettingsbuilders1)

editViewSettingsBuilder1.InheritSettingsFromPreferences()

'editViewSettingsBuilder1.ViewStyle.ViewStyleGeneral.ExtractedEdges = NXOpen.Preferences.GeneralExtractedEdgesOption.Associative

Dim markId2 As NXOpen.Session.UndoMarkId = Nothing
markId2 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId2, Nothing)

Dim nXObject3 As NXOpen.NXObject = Nothing
nXObject3 = editViewSettingsBuilder1.Commit()

theSession.SetUndoMarkName(markId1, "Settings")

editViewSettingsBuilder1.Destroy()

End If
Next
Next

lw.Close()

End Sub

' This function will work for:
' an object which "Resides on drawing" or is "View Dependent In" a DraftingView
' a DraftingView
' a DrawingSheet.View
' Returns Nothing for all other (ie. model mode) objects
'code by Amy Webster of GTAC,
'GTAC document: nx_api4936 or nx_api4937
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

End Module

Thanks for sharing your code!