Solved: Ilogic drawing linear dimension automation

kairobert · ‎08-09-2023

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 · ‎08-09-2023

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.

If this post solved your question, please kindly mark it as "Solution"

If this post helped out in any way to solve your question, please drop a "Like"

@LinkedIn @JohnCockerill

Michael.Navara · ‎08-09-2023

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

VBA Object Browser for Inventor | iLogic for VisualStudio | Inventor AddIn Debugger

kairobert · ‎08-10-2023

Yes, that works 😄

Ilogic drawing linear dimension automation

Ilogic drawing linear dimension automation

Ilogic drawing linear dimension automation

Forums Links

Post to forums