Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Arrange Angular Dimensions

Curtis_Waguespack
Consultant

Arrange Angular Dimensions

Curtis_Waguespack
Consultant
Consultant

How do we set the text placement for existing angular dimensions? 

Attached are a couple of 2022 files to look at, with a few iLogic rules, but I'm not seeing a way to set the text placement consistently or predictably. I'm probably overlooking something though? ๐Ÿ˜ฌ

 

I've tried a few things based the AngularGeneralDimension API object:

https://help.autodesk.com/view/INVNTOR/2023/ENU/?guid=GUID-587454C3-2D52-4DBF-844A-A47E1320F26E


Note that these are not dimensions that are programmatically placed, but just manually placed dimensions that need to be arranged programmatically after some view updates ( size changes, scaling, etc. ).

 

So for instance, after some update, the placed angular dimensions look something like this:

 

Curtis_Waguespack_0-1676316983693.png

 

This is the result I'm looking for:

 

Pic2.PNG

 
 
 

Thank you!

Curtis

Reply
Accepted solutions (4)
1,222 Views
10 Replies
Replies (10)

lmc.engineering
Advocate
Advocate
Accepted solution

Hi Curtis,

 

I have a solution here that might be of interest; it's one of those things that could very well be over complicated, but was created in a moment of need..


I have it so the dim object is selected, however, it just needs to be feed with your objects. Key driving variables are 'TextQuadrant' & 'TextPositionRadius'.

 

Public Sub RepositionAngluarDimText()
	Dim oDim As DrawingDimension
	oDim = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingDimensionFilter, "Select the face")
	'oDim = Nothing 'Your dim object
	Dim oCurve1 As DrawingCurve = oDim.IntentOne.Geometry.Segments(1).Parent
	Dim oCurve2 As DrawingCurve = oDim.Intenttwo.Geometry.Segments(1).Parent

	'get curve points
	Dim C1strt, C1end As Point2d
	C1strt = oCurve1.StartPoint
	C1end = oCurve1.EndPoint

	Dim C2strt, C2end As Point2d
	C2strt = oCurve2.StartPoint
	C2end = oCurve2.EndPoint

	'get coords of curve points
	Dim x1, y1, x2, y2 As Double
	Dim a1, b1, a2, b2 As Double
	x1 = C1strt.X
	y1 = C1strt.Y
	x2 = C1end.X
	y2 = C1end.Y

	a1 = C2strt.X
	b1 = C2strt.Y
	a2 = C2end.X
	b2 = C2end.Y

	'find x,y intersection of curves in order to get the centre point of the dim
	Dim intersect As Double() = SlopeIntersectPoint(x1, y1, x2, y2, a1, b1, a2, b2)
	Dim intersectx As Double = intersect(0)
	Dim intersecty As Double = intersect(1)

	'set text 'quadrant' position
	Dim TextPositionRadius As Double = 1.5
	Dim TextQuadrant As String = "1x"
	Dim textPos As Double() = TextQuadrantPosition(intersectx, intersecty, TextPositionRadius, TextQuadrant )
	Dim textX As Double = textPos(0)
	Dim textY As Double = textPos(1)

	Dim oTG As TransientGeometry
	oTG = g_invApp.TransientGeometry
	Dim oTextOrigin As Point2d = oTG.CreatePoint2d(textX, textY)

	oDim.Text.Origin = oTextOrigin
	oDim.CenterText
End Sub

Getting the slope intersection of the drawing curves: Note; method will error out on parallel lines.. but won't be an issue on angular dims.

Private Function SlopeIntersectPoint(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double,
	A1 As Double, B1 As Double, A2 As Double, B2 As Double) As Double()
	Dim dx As Double
	Dim dy As Double
	Dim da As Double
	Dim db As Double
	Dim t As Double

	dx = X2 - X1
	dy = Y2 - Y1
	da = A2 - A1
	db = B2 - B1

	If (da * dy - db * dx) = 0 Then
		' The segments are parallel.
		Return {dx, dy}
	End If
	t = (da * (Y1 - B1) + db * (A1 - X1)) / (db * dx - da * dy)
	
	Dim IntersectPoint As Double()
	IntersectPoint = {X1 + t * dx, Y1 + t * dy }
	Return IntersectPoint
End Function

Lastly, returning the coords of the desired quadrant. 

 

Private Function TextQuadrantPosition(intersectx As Double, intersecty As Double, rad As Double, quad As String) As Double()
	Dim nudge As Double = 0.3
	Dim x, y As Double
	'Four quadrants based on x & y axis. Where (+x,+y) is the first quadrant, then clockwise through subsequent quadrants: 1 = (+x,+y), 2 = (+x-y), 3 = (-x-y), 4 = (-x,+y)
	'Each quadrant is split in to two along the 45 degree, giving additional positional control, as four quadrants isn't often enough. eg 1x, 1y, 2x, 2y ... 
	'1x would place in the lower 45 of the quadrant "1". 1y would be the upper 45 of the quadrant "1".
	'2x would place in the upper of quadrant 2. 2y would place in the lower of quadrant 2
	'The 'nudge' variable nudges the text position To the left, Right, above, or below the axis lines.. This allows us to make use of the 'Dim.CenterText' which centres the text in it's quadrant.
	'the nudge variable could be used to precisely place the text with relative ease.
	Select Case quad
		'   '---------------------------------------
		Case ("1")
			x = intersectx + rad
			y = intersecty + nudge
		Case "1x"
			x = intersectx + rad
			y = intersecty + nudge
		Case "1y"
			x = intersectx + nudge
			y = intersecty + rad
			'---------------------------------------
		Case "2"
			x = intersectx + nudge
			y = intersecty - rad
		Case "2x"
			x = intersectx + rad
			y = intersecty - nudge
		Case "2y"
			x = intersectx + nudge
			y = intersecty - rad
			'---------------------------------------
		Case "3"
			x = intersectx - rad
			y = intersecty - nudge
		Case "3x"
			x = intersectx - rad
			y = intersecty - nudge
		Case "3y"
			x = intersectx - nudge
			y = intersecty - rad
			'---------------------------------------
		Case "4"
			x = intersectx - nudge
			y = intersecty + rad
		Case "4x"
			x = intersectx - rad
			y = intersecty + nudge
		Case "4y"
			x = intersectx - nudge
			y = intersecty + rad
			'---------------------------------------
		Case Else
			x = intersectx
			y = intersecty
	End Select

	Return {x, y}
End Function

It wouldn't be too far fetched to modify this for a bit more automation around quadrants and radius, I just never got that far.
Something using the below could be worked in; by finding the inclination of the drawing curves it is probably possible to auto select the quadrant.

Public Shared Function LineInclinationFromXAxis(x1 As Double, y1 As Double,
						x2 As Double, y2 As Double) As Double
	Dim theta As Double
	theta = Math.Atan2((y2 - y1), (x2 - x1))
	LineInclinationFromXAxis = theta
End Function


Hopefully of some use.

JelteDeJong
Mentor
Mentor
Accepted solution

It took me some time to create this rule and now I see that @lmc.engineering also has a (probably as better) solution. And mine is not even finished. It will not work when there are no extension lines.  (maybe i should have used the intents for the coordinates.)  Also, my new text point is always in the first quadrant...

Anyway, I already created it so maybe it is of some use.

Sub Main()

    Dim doc As DrawingDocument = ThisDoc.Document
    Dim sheet As Sheet = doc.ActiveSheet
    Dim dimension As AngularGeneralDimension = sheet.DrawingDimensions.Item(1)

    ResetTextPoint(dimension)

End Sub

Public Sub ResetTextPoint(dimension As AngularGeneralDimension)
    Dim intersectionPoint = GetInetersectionPoint(dimension.ExtensionLineOne, dimension.ExtensionLineTwo)

    Dim p1 As Point2d = dimension.ExtensionLineOne.EndPoint
    Dim p2 As Point2d = dimension.ExtensionLineTwo.EndPoint

    Dim a1 As Double = GetAngleBetween2Points(p1, intersectionPoint)
    Dim a2 As Double = GetAngleBetween2Points(p2, intersectionPoint)

    Dim newAngle = (a1 + a2) / 2

    Dim distance = 2.5

    Dim x = Math.Cos(newAngle) * distance + intersectionPoint.X
    Dim y = Math.Sin(newAngle) * distance + intersectionPoint.Y

    ' You need to create code here to set the text point to the correct quadrant

    Dim newTextPoint = ThisApplication.TransientGeometry.CreatePoint2d(x, y)

    dimension.Text.Origin = newTextPoint
End Sub


Public Function GetAngleBetween2Points(p1 As Point2d, p2 As Point2d)
    ' https://stackoverflow.com/questions/12891516/math-calculation-to-retrieve-angle-between-two-points
    Dim xDiff As Double = p2.X - p1.X
    Dim yDiff As Double = p2.Y - p1.Y
    Return Math.Atan2(yDiff, xDiff) ' * 180.0 / Math.PI
End Function

Public Function GetInetersectionPoint(line1 As LineSegment2d, line2 As LineSegment2d) As Point2d
    ' https://www.topcoder.com/thrive/articles/Geometry%20Concepts%20part%202:%20%20Line%20Intersection%20and%20its%20Applications

    Dim x1 = line1.StartPoint.X
    Dim y1 = line1.StartPoint.Y
    Dim x2 = line1.EndPoint.X
    Dim y2 = line1.EndPoint.Y

    Dim A1 = y2 - y1
    Dim B1 = x1 - x2
    Dim C1 = A1 * x1 + B1 * y1

    x1 = line2.StartPoint.X
    y1 = line2.StartPoint.Y
    x2 = line2.EndPoint.X
    y2 = line2.EndPoint.Y

    Dim A2 = y2 - y1
    Dim B2 = x1 - x2
    Dim C2 = A2 * x1 + B2 * y1

    Dim delta As Double = A1 * B2 - A2 * B1

    If (delta = 0) Then
        Throw New ArgumentException("Lines are parallel")
    End If

    Dim x As Double = (B2 * C1 - B1 * C2) / delta
    Dim y As Double = (A1 * C2 - A2 * C1) / delta

    Return ThisApplication.TransientGeometry.CreatePoint2d(x, y)
End Function

Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Blog: hjalte.nl - github.com

lmc.engineering
Advocate
Advocate

I must admit, this did take me a while at the time. It's a nice to see the similar approaches.

The next iteration would be to place the text in it's quadrant automatically. I suppose with knowing the relative angle of each curve to the x or y axis, and the angle between them, the text can be placed precisely without the need for a hard coded variable.. I feel a late night coming on..

 

0 Likes

Michael.Navara
Advisor
Advisor
Accepted solution

May be it is too late, but here is my minimalistic approach ๐Ÿ˜‰

 

Dim angularDim As AngularGeneralDimension = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingDimensionFilter, "Pick angular dimension")

Dim angularDimLine As Arc2d = angularDim.DimensionLine
Dim centerPoint As Point2d = angularDimLine.Center
Dim textPosition As Point2d = angularDim.Text.Origin

Dim textVector As Vector2d = centerPoint.VectorTo(textPosition)
textVector.Normalize()
textVector.ScaleBy(1) ' Set distance from center [cm]

Dim newTextPosition As Point2d = centerPoint.Copy()
newTextPosition.TranslateBy(textVector)

angularDim.Text.Origin = newTextPosition

Curtis_Waguespack
Consultant
Consultant
0 Likes

srinivasanyl
Contributor
Contributor

Hi

this is useful, but single selection is coming. how could i arrange all angular dimensions in a sheet?

0 Likes

Curtis_Waguespack
Consultant
Consultant

@srinivasanyl , this is what I ended up using for all views on the drawing

 

Dim oDrawDoc As DrawingDocument = ThisDoc.Document
Dim oSheet As Sheet = ThisDoc.Document.ActiveSheet

Dim oDrawingDim As GeneralDimension

	For Each oDrawingDim In oSheet.DrawingDimensions
		'filter for only angular dims
		If Not oDrawingDim.Type = ObjectTypeEnum.kAngularGeneralDimensionObject Then Continue For
		If TypeOf oDrawingDim Is AngularGeneralDimension Then
			Dim angularDimLine As Arc2d = oDrawingDim.DimensionLine
			Dim textPosition As Point2d = oDrawingDim.Text.Origin
			Dim centerPoint As Point2d = angularDimLine.Center

			Dim textVector As Vector2d = centerPoint.VectorTo(textPosition)
			textVector.Normalize()
			textVector.ScaleBy(1.2) ' Set distance from center [cm]

			Dim newTextPosition As Point2d = centerPoint.Copy()
			newTextPosition.TranslateBy(textVector)

			oDrawingDim.Text.Origin = newTextPosition
			oDrawingDim.CenterText

		End If
	Next

 

0 Likes

srinivasanyl
Contributor
Contributor

hi,

thanks for the quick response. 

I tried this code also, but error coming!

error messege screenshot attached!

0 Likes

Curtis_Waguespack
Consultant
Consultant
Accepted solution

Hi @srinivasanyl 

 

That version did indeed have an issue when there were other types of dimension on the sheet ( ordinate dimensions for example) .  Give this version a try.

 

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

 

Dim oDrawDoc As DrawingDocument = ThisDoc.Document
Dim oSheet As Sheet = ThisDoc.Document.ActiveSheet

Dim oDrawingDim As GeneralDimension

	For Each oDrawingDim In oSheet.DrawingDimensions.GeneralDimensions
		'filter for only angular dims
		If Not oDrawingDim.Type = ObjectTypeEnum.kAngularGeneralDimensionObject Then Continue For
		If TypeOf oDrawingDim Is AngularGeneralDimension Then
			Dim angularDimLine As Arc2d = oDrawingDim.DimensionLine
			Dim textPosition As Point2d = oDrawingDim.Text.Origin
			Dim centerPoint As Point2d = angularDimLine.Center

			Dim textVector As Vector2d = centerPoint.VectorTo(textPosition)
			textVector.Normalize()
			textVector.ScaleBy(1.2) ' Set distance from center [cm]

			Dim newTextPosition As Point2d = centerPoint.Copy()
			newTextPosition.TranslateBy(textVector)

			oDrawingDim.Text.Origin = newTextPosition
			oDrawingDim.CenterText

		End If
	Next
0 Likes

srinivasanyl
Contributor
Contributor
wow.. its working great!. I must thankful for the reply.