topic Re: Ilogic drawing linear dimension automasion in Inventor Programming Forum

Ilogic drawing linear dimension automation

kairobert — Mon, 11 Sep 2023 08:09:44 GMT

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()

Re: Ilogic drawing linear dimension automasion

FINET_Laurent — Wed, 09 Aug 2023 12:05:01 GMT

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.

Re: Ilogic drawing linear dimension automasion

Michael.Navara — Wed, 09 Aug 2023 15:00:41 GMT

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

Re: Ilogic drawing linear dimension automasion

kairobert — Thu, 10 Aug 2023 09:08:44 GMT

Yes, that works 😄