Ilogic drawing linear dimension automation

[kairobert]

Hello. I`m working with an drawing and i`m trying to automate some dimensions. My question is: is it possible to control where the text in my dimension ends up? As you can see, its not easy to read.

Here is my code:

'On Error Resume Next
Dim Sheet_1 = ThisDrawing.Sheets.ItemByName("Sheet:1")
Dim VIEW1 = Sheet_1.DrawingViews.ItemByName("VIEW1")
	Dim VIEW2 = Sheet_1.DrawingViews.ItemByName("VIEW2")
Dim genDims = Sheet_1.DrawingDimensions.GeneralDimensions



Dim uStopper = VIEW2.GetIntent("Stopper luke:1", "Edge_oppe_stopper")'Kant oppe flattstål/stopper brygge
	Dim lStopper = VIEW2.GetIntent("Stopper luke:1", "Edge_nede_stopper")'Kant nede flattstål/stopper brygge
		Dim wbStopper = VIEW2.GetIntent("Stopper luke:1", "Edge_bak_stopper")'Kant bak flattstål/stopper brygge
Dim uRør = VIEW2.GetIntent("Høyre side:1", "Edge_øvre")'Kant oppe på høyre rør
	Dim bRør = VIEW2.GetIntent("Høyre side:1", "Edge_bak_rør")'edge bak på høyre rør
		Dim wiRør = VIEW1.GetIntent("Venstre side:1", "Edge_innside_rør")'edge innside på høyre rør
			Dim wuRør = VIEW1.GetIntent("Venstre side:1", "Edge_utside_rør")'edge utside på høyre rør
				Dim huRør = VIEW1.GetIntent("Øvre:1", "Edge_oppe_rør")'edge oppe på øvre rør
					Dim hlRør = VIEW1.GetIntent("Øvre:1", "Edge_nede_rør")'edge nede på øvre rør
						Dim huRørØvre = VIEW1.GetIntent("Nedre:1", "Edge_oppe_rør")'edge oppe på nedre rør
							Dim hlRørØvre = VIEW1.GetIntent("Nedre:1", "Edge_nede_rør")'edge nede på nedre rør
Dim skrue = VIEW2.GetIntent("Skrue_demper:1", "Edge_skrue") 'Kant/Senter skrue demper



ThisDrawing.BeginManage()
Dim linDim1 = genDims.AddLinear("Stopper_vert", VIEW2.SheetPoint(-3, 0.5), uStopper, uRør) 'Målsetting flattstål/stopper brygge
Dim linDim2 = genDims.AddLinear("Skrue_demper", VIEW2.SheetPoint(4, 0), skrue, uRør) 'Målsetting skrue demper
Dim linDim3 = genDims.AddLinear("Stopper_width", VIEW2.SheetPoint(0, 0.55), wbStopper, bRør) 'Målsetting width flattstål/stopper brygge
Dim linDim4 = genDims.AddLinear("Stopper_height", VIEW2.SheetPoint(4, 0), uStopper, lStopper) 'Vertikal målsetting demper
Dim linDim5 = genDims.AddLinear("RørVside", VIEW1.SheetPoint(0, 0.5), wiRør, wuRør)
Dim linDim6 = genDims.AddLinear("RørØvre", VIEW1.SheetPoint(0.5, 1.2), huRør, hlRør)
Dim linDim7 = genDims.AddLinear("RørNedre", VIEW1.SheetPoint(0.5, 0), huRørØvre, hlRørØvre)
ThisDrawing.EndManage()

[FINET_Laurent]

Hi @kairobert, 

You could use this simple principle : 

Dim linDim1  As Inventor.LinearGeneralDimension = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingDimensionFilter, "Pick a dim")
linDim1 .Text.Origin = ThisApplication.TransientGeometry.CreatePoint2d(linDim1.Text.Origin.X + 2, linDim1.Text.Origin.Y)
'd.Text.Origin = ThisApplication.TransientGeometry.CreatePoint2d(d.Text.Origin.X, d.Text.Origin.Y + 2)

This would move the dimension text a little bit to the right. 

Kind regards,

FINET L.

[Michael.Navara · Accepted solution]

This code also can help you

Dim drawing As DrawingDocument = ThisDoc.Document
Dim sheet As Sheet = drawing.ActiveSheet
Dim generalDimensions As GeneralDimensions = sheet.DrawingDimensions.GeneralDimensions

'Iterate all general dimensions on active sheet
For Each dimension As GeneralDimension In generalDimensions
    'Get required dimension properties
    Dim dimensionText As DimensionText = dimension.Text
    Dim textOrigin As Point2d = dimensionText.Origin
    'Text circumcircle radius 
    Dim textRadius As Double = textOrigin.VectorTo(dimensionText.RangeBox.MaxPoint).Length

    'Only linear dimension lines are expected (angular dimensions require its own implementation)
    Dim dimensionLine As LineSegment2d = TryCast(dimension.DimensionLine, LineSegment2d)
    If dimensionLine Is Nothing Then Continue For

    Dim newPositionStepVector = dimensionLine.Direction.AsVector()
    Dim newPositionRequired As Boolean = False
    Do
        'Look for some objects near the dimension text
        Dim nearObjects As ObjectsEnumerator = sheet.FindUsingPoint(textOrigin, textRadius)
        If nearObjects.Count > 0 Then
            'Some objects found
            newPositionRequired = True
            textOrigin.TranslateBy(newPositionStepVector)
        Else
            'Nothing here
            If newPositionRequired Then
                'Re-position dimension text
                dimension.Text.Origin = textOrigin
            End If
            'Go to the next dimension
            Continue For
        End If
    Loop
Next

[kairobert]

Yes, that works 😄