Hello
Hopefully I understand what happens when.
You have a part wih one or more revolve feature(s). The features unique named to identify them. You have one or more user parameter in your part. There is an relation between the revolve feature name and the parameter namer. I assume the feature and the corresponding parameter have same name.
There seem's to be an error in current Inventor release (2022.1) . If the model annotation with a linked user parameter is deleted, the user parameter is also deleted.
Private Sub Main()
Dim oApp As Inventor.Application= ThisApplication
Dim oDoc As Inventor.PartDocument= oApp.ActiveDocument
Dim oDef As Inventor.PartComponentDefinition= oDoc.ComponentDefinition
Dim oTG As Inventor.TransientGeometry= oApp.TransientGeometry
Dim oRepMan As Inventor.RepresentationsManager= oDef.RepresentationsManager
Dim oDesignViewReps As Inventor.DesignViewRepresentations= oRepMan.DesignViewRepresentations
Dim oOuterFace As Inventor.Face
Dim oRevolveFeature As Inventor.RevolveFeature
For Each oRevolveFeature In oDef.Features.RevolveFeatures
If Feature.IsActive(oRevolveFeature.Name) And oRevolveFeature.HealthStatus = HealthStatusEnum.kUpToDateHealth Then
If CheckExistLeader(oRevolveFeature) = False Then
oOuterFace = GetOuterFace(oRevolveFeature)
Dim oAnnoPlaneDef As Inventor.AnnotationPlaneDefinition= oDef.ModelAnnotations.CreateAnnotationPlaneDefinitionUsingPlane(oDef.WorkPlanes(2))
Dim oLeaderPoints As Inventor.ObjectCollection= oApp.TransientObjects.CreateObjectCollection
Dim oIntentPoint As Point
Select Case oOuterFace.SurfaceType
Case SurfaceTypeEnum.kConeSurface:
oIntentPoint = GetPointOnCone(oOuterFace)
Case SurfaceTypeEnum.kCylinderSurface:
oIntentPoint = GetPointOnCylinder(oOuterFace)
End Select
Dim oLeaderIntent As Inventor.GeometryIntent= oDef.CreateGeometryIntent(oOuterFace, oIntentPoint)
'The Leaderpoint should be relative positioned to the LeaderPoint 1
Call oLeaderPoints.Add(oTG.CreatePoint(oIntentPoint.X + 1, 0, oIntentPoint.Z + 1))
Call oLeaderPoints.Add(oLeaderIntent)
Dim sFormattedText As String
sFormattedText = "NaN"
Dim oLeaderDef As Inventor.ModelLeaderNoteDefinition = oDef.ModelAnnotations.ModelLeaderNotes.CreateDefinition(oLeaderPoints, sFormattedText, oAnnoPlaneDef)
Dim oLeader As Inventor.ModelLeaderNote= oDef.ModelAnnotations.ModelLeaderNotes.Add(oLeaderDef)
oLeader.Definition.Text.FormattedText = GetParamValue(oRevolveFeature)
oOuterFace = Nothing
End If
End If
Next
End Sub
Private Function CheckExistLeader(ByVal oRevolveFeature As RevolveFeature) As Boolean
Dim oPartCompDef As PartComponentDefinition = oRevolveFeature.Parent
Dim oLeaderNotes As ModelLeaderNotes = oPartCompDef.ModelAnnotations.ModelLeaderNotes
Dim oFace As Face
Dim oIntentFace As Face
Dim oLeaderNote As ModelLeaderNote
For Each oLeaderNote In oLeaderNotes
oIntentFace = oLeaderNote.Definition.Intent.Geometry
For Each oFace In oRevolveFeature.Faces
If oIntentFace Is oFace Then
Return True
End If
Next
Next
End Function
Private Function GetOuterFace(ByVal oRevolveFeature As Inventor.RevolveFeature) As Inventor.Face
Dim oFace As Inventor.Face
Dim oOuterFace As Inventor.Face
For Each oFace In oRevolveFeature.Faces
If oFace.SurfaceType = SurfaceTypeEnum.kConeSurface Or oFace.SurfaceType = SurfaceTypeEnum.kCylinderSurface Then
If Not oOuterFace Is Nothing Then
If oFace.Geometry.Radius > oOuterFace.Geometry.Radius Then
oOuterFace = oFace
End If
Else
oOuterFace = oFace
End If
End If
Next
GetOuterFace = oOuterFace
End Function
Private Function GetPointOnCone(ByVal oFace As Face) As Point
Dim oCone As Cone= oFace.Geometry
Dim oSB As SurfaceBody= oFace.SurfaceBody
Dim oBasis As Point = oCone.BasePoint
Dim oRadius As Double = oCone.Radius
Dim oEnts As Inventor.ObjectsEnumerator
Dim oPoints As Inventor.ObjectsEnumerator
Dim oVector As Vector= ThisApplication.TransientGeometry.CreateVector(0, 1, 0)
Call oSB.FindUsingRay(oBasis, oVector.AsUnitVector, oRadius, oEnts, oPoints, False)
If oEnts.Count > 0 Then
Dim i As Integer
For i = 1 To oEnts.Count
If oEnts(i) Is oFace Then
GetPointOnCone = oPoints(i)
End If
Next
End If
End Function
Private Function GetPointOnCylinder(ByVal oFace As Face) As Point
Dim oCylinder As Cylinder= oFace.Geometry
Dim oSB As SurfaceBody= oFace.SurfaceBody
Dim oBasis As Point = oCylinder.BasePoint
Dim oRadius As Double= oCylinder.Radius
Dim oEnts As Inventor.ObjectsEnumerator
Dim oPoints As Inventor.ObjectsEnumerator
Dim oVector As Vector = ThisApplication.TransientGeometry.CreateVector(0, 1, 0)
Call oSB.FindUsingRay(oBasis, oVector.AsUnitVector, oRadius, oEnts, oPoints, False)
If oEnts.Count > 0 Then
Dim i As Integer
For i = 1 To oEnts.Count
Call ThisApplication.ActiveDocument.SelectSet.Select(oEnts(i))
Select Case oEnts(i).Type
Case kVertexObject:
Case kEdgeObject:
Dim oEdge As Edge= oEnts(i)
Dim oConFace As Face
For Each oConFace In oEdge.Faces
If oConFace Is oFace Then
GetPointOnCylinder = oPoints(i)
End If
Next
Case kFaceObject:
GetPointOnCylinder = oPoints(i)
End Select
Next
End If
End Function
Private Function GetParamValue(ByVal oRevolveFeature As RevolveFeature) As String
GetParamValue = "NaN"
Dim oPartDoc As PartDocument= oRevolveFeature.Parent.Document
Dim oUserParam As UserParameter
For Each oUserParam In oPartDoc.ComponentDefinition.Parameters.UserParameters
If oRevolveFeature.Name = oUserParam.Name Then
GetParamValue = "<Parameter Resolved='True' ComponentIdentifier='" & oPartDoc.FullFileName & "' Name='" & oUserParam.Name & "' Precision='" & oUserParam.Precision & "'>" & oUserParam.Value & "</Parameter>"
Exit For
End If
Next
End Function
R. Krieg
RKW Solutions
www.rkw-solutions.com
