VBA Macro (Ilogic) to select and color dimensions

[ollie_brownBWLCL]

Hello, I have been trying to write a macro that will allow me to select all dimensions on a drawing (with multiple views and pages) and re color them. I have been down many rabbit holes but have not been able to solve it.

For Each oDim In oSheet.DrawingDimensions.GeneralDimensions
	Try
		'linear dimension
		If oDim.IntentOne.Geometry.Parent.Name = "VIEW2" 
			oDDoc.SelectSet.Select(oDim)
		End If
	Catch
		'circle dimension
		If oDim.Intent.Geometry.Parent.Name = "VIEW2" 
			oDDoc.SelectSet.Select(oDim)
		End If
	End Try
Next

I have this but it only allows me to select dimensions with certain view names "VIEW2"

[Andrii_Humeniuk · Accepted solution]

Hi @ollie_brownBWLCL . This iLogic code can select all GeneralDimensions on all drawing sheets. Also, if you need to change the color of the dimensions, you can use line 15.

Sub main
	Dim iInvApp As Inventor.Application = ThisApplication
	Dim oDoc As Document = iInvApp.ActiveDocument
	If Not TypeOf oDoc Is DrawingDocument Then Exit Sub
	Dim oDDoc As DrawingDocument = oDoc
	Dim oColor As Color = iInvApp.TransientObjects.CreateColor(125, 125, 125)
	Dim oTrans As Transaction 
	oTrans = iInvApp.TransactionManager.StartTransaction(oDDoc, "Change color dimensions")
	For i As Integer = 1 To oDDoc.Sheets.Count
		If oDDoc.Sheets(i).DrawingDimensions.Count = 0 Then Continue For
		If oDDoc.Sheets(i).DrawingDimensions.GeneralDimensions.Count = 0 Then Continue For
		Dim oGnrDmns As GeneralDimensions = oDDoc.Sheets(i).DrawingDimensions.GeneralDimensions
		For iD As Integer = 1 To oGnrDmns.Count
			oDDoc.SelectSet.Select(oGnrDmns(iD))
'			oGnrDmns(iD).Layer.Color = oColor
		Next iD
	Next i
	oTrans.End()
End Sub

[ollie_brownBWLCL]

Works a treat thank you!!!

[ollie_brownBWLCL]

I would like to remove angular dimensions from the selection. Any chance you could help me with that? Inventor rejects the way I have been defining angular dimensions

[Andrii_Humeniuk · Accepted solution]

Hi @ollie_brownBWLCL . No problem. I added a check (line 14) now all angular dimensions are not selected.

Sub main
	Dim iInvApp As Inventor.Application = ThisApplication
	Dim oDoc As Document = iInvApp.ActiveDocument
	If Not TypeOf oDoc Is DrawingDocument Then Exit Sub
	Dim oDDoc As DrawingDocument = oDoc
	Dim oColor As Color = iInvApp.TransientObjects.CreateColor(125, 125, 125)
	Dim oTrans As Transaction 
	oTrans = iInvApp.TransactionManager.StartTransaction(oDDoc, "Change color dimensions")
	For i As Integer = 1 To oDDoc.Sheets.Count
		If oDDoc.Sheets(i).DrawingDimensions.Count = 0 Then Continue For
		If oDDoc.Sheets(i).DrawingDimensions.GeneralDimensions.Count = 0 Then Continue For
		Dim oGnrDmns As GeneralDimensions = oDDoc.Sheets(i).DrawingDimensions.GeneralDimensions
		For iD As Integer = 1 To oGnrDmns.Count
			If oGnrDmns(iD).Type <> ObjectTypeEnum.kAngularGeneralDimensionObject Then		
				oDDoc.SelectSet.Select(oGnrDmns(iD))
'				oGnrDmns(iD).Layer.Color = oColor
			End If
		Next iD
	Next i
	oTrans.End()
End Sub

[ollie_brownBWLCL]

Legend!!!