Looking for help, my code stopped working

[rhasell]

Please help, this is a massive time saver.

I have had a section of code which has been running for years, today it stopped working?

What is does:

In the drawing view I select a curved line

Step 1 - Add an Angle dimension to the curve

Step 2 - Add an Arc Length dimension to the line

Step 3 - Overwrite the Angle Dimension with the Arc Length dimension value

Step 4- Place the Arc Length dimension on a hidden layer

This still works for a model edge, however it has stopped working for sketch lines

In other words, when generating drawings I used sketches in the view and add dimension to the sketch lines.

This has stopped working.

Code:

'Revision 2
'Change the Dimension location to a fixed value
'
'IDW_Angle_and Arc_Length Dimension
'This code will automatically create an arclength dimension, as well as add an agle equivalent dimension.
'on the selected curve. It will automatically place it on the Hidden Layer.
'Once again, a time saving
'NOTE:
'Refer the code IDW_ArcLength Dimension which is identical, It only does arc length

'*** NB***
'The Angular dimension MUST be edited before exporting.
'I cannot explain why, but it will not format the export correctly

'Reg Hasell
'Rev 1 18.07.19

Sub main()
Dim oDoc As DrawingDocument
oDoc = ThisDoc.Document

Dim oSheet As Sheet
oSheet = oDoc.ActiveSheet

Dim oCurveSeg As DrawingCurveSegment
oCurveSeg = ThisApplication.CommandManager.Pick(kDrawingCurveSegmentFilter, "Select an arc drawing curve")

If oCurveSeg Is Nothing Then
	Exit Sub
End If

Dim oCurve As DrawingCurve
oCurve = oCurveSeg.Parent

If oCurve.CurveType <> kCircularArcCurve Then
	MessageBox.Show("The selected drawing curve is not an arc curve!", "Title")
	Exit Sub
End If

Dim dPosX As Double, dPosY As Double
''If oCurve.MidPoint.X <= oCurve.CenterPoint.X Then
''	dPosX = oCurve.MidPoint.X * 3 / 2 - oCurve.CenterPoint.X / 2
''Else
''	dPosX = oCurve.MidPoint.X / 2 + oCurve.CenterPoint.X / 2
dPosX = oCurve.MidPoint.X 'Rev 2
''End If
''If oCurve.MidPoint.Y <= oCurve.CenterPoint.Y Then
''	dPosY = oCurve.MidPoint.Y * 3 / 2 - oCurve.CenterPoint.Y / 2
''Else
''	dPosY = oCurve.MidPoint.Y / 2 + oCurve.CenterPoint.Y / 2
dPosY = oCurve.MidPoint.Y +1 'Rev 2
''End If

Dim oPos As Point2d
oPos = ThisApplication.TransientGeometry.CreatePoint2d(dPosX, dPosY)

Dim oIntent As GeometryIntent
oIntent = oSheet.CreateGeometryIntent(oCurve)
Dim oArcLayer = oDoc.StylesManager.Layers("1_Dim_hidden")

Dim oArcLenDim As LinearGeneralDimension
oArcLenDim = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPos, oIntent, , kArcLengthDimensionType, , , oArcLayer)
'oArcLenDim = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPos, oIntent, , kArcLengthDimensionType)

ArcLength = Round(oArcLenDim.ModelValue, 1)
'oArcLenDim.Delete 'Removed because I can do both in one step

'Dim oLayer = oDoc.StylesManager.Layers("Dimension")
Dim oDimStyle = oDoc.StylesManager.DimensionStyles("Default")

'oArcLenDim = oSheet.DrawingDimensions.GeneralDimensions.AddAngular(oPos, oIntent)
'oAngleDim = oSheet.DrawingDimensions.GeneralDimensions.AddAngular(oPos, oIntent, , , , False) ' This line works
'oAngleDim = oSheet.DrawingDimensions.GeneralDimensions.AddAngular(oPos, oIntent, , , , , , oDimStyle, oLayer)
oAngleDim = oSheet.DrawingDimensions.GeneralDimensions.AddAngular(oPos, oIntent, , , , , , oDimStyle)
oAngleDim.HideValue = True

'Define colour
'Note: The export to Autocad was not formatting the Text correctly.
Dim oColor As Color
   'set color to black
   oColor = ThisApplication.TransientObjects.CreateColor(0, 0, 0)
   oColor.ColorSourceType = ColorSourceTypeEnum.kLayerColorSource

Dim oDimensionText As DimensionText = oAngleDim.Text
oSym = "<StyleOverride Font='AIGDT' FontSize='0.25'>" & Chr(94) & "</StyleOverride>"
Dim oValue=ArcLength * 10
oDimensionText.LineSpacingType = (29185) ' this is the correct string to format the line for "Exact"
oDimensionText.HorizontalJustification = (19969) ' this is the correct string to format the line for "Center Justifictaion"
oDimensionText.LineSpacing = ("0.25") ' This will set the dimension text to Multiple of 0.1\
oDimensionText.Color = oColor
'oAngleDim.Text.FormattedText = ArcLength * 10
oAngleDim.Text.FormattedText = oSym & "<br/>" & oValue
sAgain()
End Sub

Sub sAgain()
	oAgain = MessageBox.Show("Again", "Rinse and Repeat", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
	If oAgain = vbYes
		Main()
	End If
End Sub

[A.Acheson]

Hi @rhasell 

I am wondering if you should be selecting a sketch entity in this case rather than drawing curve? It sounds like that is what the error message is describing. Your telling it you want a drawing segment and your giving it a sketch line. 

See help page here.

Maybe remove the declaration and check the object type your selecting.  If the sketch is projected does it make any difference? 

[rhasell]

I will try and disable some of the declarations.

Unfortunately, I need to select line segments, as I have multiple items welded to a curved CHS, I then sketch lines to each point and dimension each line

example: There is sketched curve over the top of the CHS (The red lines are the hidden arclength dimensions)

[Michael.Navara]

This looks like a similar issue solved here. See this post paragraph 1).

[rhasell]

Thanks mate

That really looks like my problem. It's been a while since I was debugging code, so hopefully it does not take long to add the "sketchline" option.

I will keep you posted.

[rhasell]

Hi

Nope, I officially give up.

I have been trying for weeks, I am unable to make head or tail of the suggested code. I have tried every conceivable format and syntax, nothing works. (For us mere mortals, aka, non-programmers, when the code gets too formal, it's harder to make sense of it)

My future is bleak with manually having to adding all the dimensions.

Thanks for trying to help.

[J-Camper]

@rhasell,

What version of inventor are you running?  Is the 2023.1 in your signature your current version?  I have no error with the code in 2023.4 when selecting an arc of a sketch line created in the drawing view and in a model sketch. 

I did not get the same error on line 26 that your error message is reporting.  I did, however, have to comment lines 59 and 69 because I don't have those layer/style names, and append lines 62 and 74 [respectively] to ignore the now missing optional layer/style inputs.

[rhasell]

Apologies, I will fix it now.

Version 2024.2

Apparently this stopped working with 2024 service pack 2

[J-Camper]

I can confirm that the arc created in a drawing view sketch is being seen as a SketchArcObject instead of a DrawingCurveSegmentObject.  This behavior is different from previous versions and i would imagine is unintended

[GosponZ]

I test your code with IV2024.1. Comment layer lines and it is working. I had few issues with 2024.2 and i removed and get back to 2024.1. It is very interesting not yet fix for several issues. 

[rhasell]

Thanks for looking, I will continue to review, and see if I can get it to work.

Hopefully it's a bug, or someone will workout how to write the code for it.

[rhasell]

Hopefully someone works out how to incorporate the new code

[J-Camper · Accepted solution]

@rhasell,

I made a workaound that appears to be functioning:

'Rule adjustment to work in 2024.2 where drawing sketch arcs are not seen as drawing durves

Sub main()
	Dim oDoc As DrawingDocument = ThisDoc.Document
	
	Dim oSheet As Sheet = oDoc.ActiveSheet
	
	Dim oCurveSeg As Object 'DrawingCurveSegment
	oCurveSeg = ThisApplication.CommandManager.Pick(kDrawingCurveSegmentFilter, "Select an arc drawing curve")
	
	If oCurveSeg Is Nothing Then
		Exit Sub
	End If
	
	Dim Normal As Boolean = True
	
	Dim oCurve As Object 'DrawingCurve
	If oCurveSeg.Type = ObjectTypeEnum.kDrawingCurveSegmentObject
		
		oCurve = oCurveSeg.Parent
		
		If oCurve.CurveType <> kCircularArcCurve Then
			MessageBox.Show("The selected drawing curve is not an arc curve!", "Title")
			Exit Sub
		End If
	Else If oCurveSeg.Type = ObjectTypeEnum.kSketchArcObject
		oCurve = oCurveSeg
		Normal = False
	End If
	
	Dim dPosX As Double, dPosY As Double
	
	If Normal
		dPosX = oCurve.MidPoint.X 'Rev 2
		dPosY = oCurve.MidPoint.Y +1 'Rev 2
	
	Else
		Dim StartPoint As Point2d = oCurve.Geometry.StartPoint.Copy
		
		dPosX = StartPoint.X * Cos(oCurve.Geometry.SweepAngle/2) - StartPoint.Y * Sin(oCurve.Geometry.SweepAngle/2)
		dPosY = (StartPoint.Y * Cos(oCurve.Geometry.SweepAngle/2) + StartPoint.X * Sin(oCurve.Geometry.SweepAngle/2)) + 1
			
	End If
	Dim oPos As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(dPosX, dPosY)
	
	Dim oIntent As GeometryIntent
	oIntent = oSheet.CreateGeometryIntent(oCurve)
	'Dim oArcLayer = oDoc.StylesManager.Layers("1_Dim_hidden")
	
	Dim oArcLenDim As LinearGeneralDimension
	oArcLenDim = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPos, oIntent, , kArcLengthDimensionType)', , , oArcLayer)
	
	ArcLength = Round(oArcLenDim.ModelValue, 1)
	
	'Dim oDimStyle = oDoc.StylesManager.DimensionStyles("Default")
	
	oAngleDim = oSheet.DrawingDimensions.GeneralDimensions.AddAngular(oArcLenDim.Text.Origin, oIntent)', , , , , , oDimStyle)
	oAngleDim.HideValue = True
	
	'Define colour
	'Note: The export to Autocad was not formatting the Text correctly.
	Dim oColor As Color
	   'set color to black
	   oColor = ThisApplication.TransientObjects.CreateColor(0, 0, 0)
	   oColor.ColorSourceType = ColorSourceTypeEnum.kLayerColorSource
	
	Dim oDimensionText As DimensionText = oAngleDim.Text
	oSym = "<StyleOverride Font='AIGDT' FontSize='0.25'>" & Chr(94) & "</StyleOverride>"
	Dim oValue=ArcLength * 10
	oDimensionText.LineSpacingType = (29185) ' this is the correct string to format the line for "Exact"
	oDimensionText.HorizontalJustification = (19969) ' this is the correct string to format the line for "Center Justifictaion"
	oDimensionText.LineSpacing = ("0.25") ' This will set the dimension text to Multiple of 0.1\
	oDimensionText.Color = oColor
	'oAngleDim.Text.FormattedText = ArcLength * 10
	oAngleDim.Text.FormattedText = oSym & "<br/>" & oValue
	sAgain()
End Sub

Sub sAgain()
	oAgain = MessageBox.Show("Again", "Rinse and Repeat", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
	If oAgain = vbYes
		Main()
	End If
End Sub

I have the layer and dimension style selections commented out, so uncomment lines 48 & 55, then also modify lines 51 & 57 so they use the two objects again.

Let me know if you have any questions

[rhasell]

Thank you so much, you are a life saver.

It works perfectly. I will go through and analyse what you did to make the magic happen.

Thanks