Evening all
I have a rule that positions each view label at a set distance below each view. Is there a way to move the label based on the number of dimensions below the view. I found this rule a while ago (And cant find it again) and cant get it to work. Can anyone help me out please
Donald
Inventor 2024
Sub Main Dim oDoc As DrawingDocument = ThisDoc.Document Dim oSheet As Sheet = oDoc.ActiveSheet Dim oView As DrawingView = oSheet.DrawingViews.Item(1) ' Assuming you're working with the first view ' Get the lowest Y position of all dimensions on the drawing sheet Dim lowestY As Double = GetLowestDimensionY(oSheet) ' Get the label associated with the view Dim oLabel As DrawingLabel = oView.Label ' Define the new position for the label Dim newX As Double = oLabel.Position.X Dim newY As Double = lowestY - 10 ' Adjust this value as needed for spacing ' Move the label to the new position oLabel.Move(New Point2d(newX, newY)) ' Refresh the drawing to see the changes oSheet.Update() End Sub Function GetLowestDimensionY(sheet As Sheet) As Double Dim lowestY As Double = Double.MaxValue For Each oDim As GeneralDimension In Sheet.DrawingDimensions Dim dimPosition As Point2d = oDim.Position Dim dimY As Double = dimPosition.Y If dimY < lowestY Then lowestY = dimY End If Next Return lowestY End Function
Solved! Go to Solution.
Evening all
I have a rule that positions each view label at a set distance below each view. Is there a way to move the label based on the number of dimensions below the view. I found this rule a while ago (And cant find it again) and cant get it to work. Can anyone help me out please
Donald
Inventor 2024
Sub Main Dim oDoc As DrawingDocument = ThisDoc.Document Dim oSheet As Sheet = oDoc.ActiveSheet Dim oView As DrawingView = oSheet.DrawingViews.Item(1) ' Assuming you're working with the first view ' Get the lowest Y position of all dimensions on the drawing sheet Dim lowestY As Double = GetLowestDimensionY(oSheet) ' Get the label associated with the view Dim oLabel As DrawingLabel = oView.Label ' Define the new position for the label Dim newX As Double = oLabel.Position.X Dim newY As Double = lowestY - 10 ' Adjust this value as needed for spacing ' Move the label to the new position oLabel.Move(New Point2d(newX, newY)) ' Refresh the drawing to see the changes oSheet.Update() End Sub Function GetLowestDimensionY(sheet As Sheet) As Double Dim lowestY As Double = Double.MaxValue For Each oDim As GeneralDimension In Sheet.DrawingDimensions Dim dimPosition As Point2d = oDim.Position Dim dimY As Double = dimPosition.Y If dimY < lowestY Then lowestY = dimY End If Next Return lowestY End Function
Solved! Go to Solution.
Solved by donald_leigh. Go to Solution.
Not tested!
Try to replace
' Dim dimPosition As Point2d = oDim.Position
' Dim dimY As Double = dimPosition.Y
' with
Dim dimY As Double = oDim.Text.Origin.Y
Not tested!
Try to replace
' Dim dimPosition As Point2d = oDim.Position
' Dim dimY As Double = dimPosition.Y
' with
Dim dimY As Double = oDim.Text.Origin.Y
The error I'm getting is:
Error on Line 11 : Type 'DrawingLabel' is not defined.
Error on Line 19 : 'New' cannot be used on an interface.
Donald
The error I'm getting is:
Error on Line 11 : Type 'DrawingLabel' is not defined.
Error on Line 19 : 'New' cannot be used on an interface.
Donald
See example, and updates in blue.
I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com
Sub Main Dim oDoc As DrawingDocument = ThisDoc.Document Dim oSheet As Sheet = oDoc.ActiveSheet Dim oView As DrawingView = oSheet.DrawingViews.Item(1) ' Assuming you're working with the first view ' Get the lowest Y position of all dimensions on the drawing sheet Dim lowestY As Double = GetLowestDimensionY(oSheet) ' Get the label associated with the view Dim oLabel As DrawingViewLabel = oView.Label ' Define the new position for the label Dim newX As Double = oLabel.Position.X Dim newY As Double = lowestY - 1 ' Adjust this value as needed for spacing Dim oPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(newX, newY) ' Move the label to the new position oLabel.Position = oPoint ' Refresh the drawing to see the changes oSheet.Update() End Sub Function GetLowestDimensionY(sheet As Sheet) As Double Dim lowestY As Double = Double.MaxValue For Each oDim As GeneralDimension In sheet.DrawingDimensions Dim dimPosition As Point2d = oDim.Text.Origin Dim dimY As Double = dimPosition.Y If dimY < lowestY Then lowestY = dimY End If Next Return lowestY End Function
See example, and updates in blue.
I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com
Sub Main Dim oDoc As DrawingDocument = ThisDoc.Document Dim oSheet As Sheet = oDoc.ActiveSheet Dim oView As DrawingView = oSheet.DrawingViews.Item(1) ' Assuming you're working with the first view ' Get the lowest Y position of all dimensions on the drawing sheet Dim lowestY As Double = GetLowestDimensionY(oSheet) ' Get the label associated with the view Dim oLabel As DrawingViewLabel = oView.Label ' Define the new position for the label Dim newX As Double = oLabel.Position.X Dim newY As Double = lowestY - 1 ' Adjust this value as needed for spacing Dim oPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(newX, newY) ' Move the label to the new position oLabel.Position = oPoint ' Refresh the drawing to see the changes oSheet.Update() End Sub Function GetLowestDimensionY(sheet As Sheet) As Double Dim lowestY As Double = Double.MaxValue For Each oDim As GeneralDimension In sheet.DrawingDimensions Dim dimPosition As Point2d = oDim.Text.Origin Dim dimY As Double = dimPosition.Y If dimY < lowestY Then lowestY = dimY End If Next Return lowestY End Function
Thanks @Curtis_Waguespack that is just what was looking for.
Thanks @Curtis_Waguespack that is just what was looking for.
Hi Again @Curtis_Waguespack
The rule you amended above will move the view label of the 1st base view only a set distance below the lowest dimension on the whole drawing. if there is another view, with dimensions (In the Y direction), that is lower then the base view the label of the base view will move below tat other view.
I have changed the rule (See below) to move all the view labels but its moving them all based on the rule dim above and places them in line with each other.
What I would like is the rule above to run on only 1 view at a time, and move the view label based on that view only.
i hope this is making sense?
new rule:
Public Sub Main Call RepositionDrawingViewLabels End Sub Private Sub RepositionDrawingViewLabels() 'Set a reference to the drawing document. 'This assumes a drawing document is active. Dim oApp = ThisApplication Dim oDoc As DrawingDocument oDoc = oApp.ActiveDocument 'Set a reference to the active sheet. Dim oActiveSheet As Sheet oActiveSheet = oDoc.ActiveSheet 'Set a reference to the TransientGeometry on active sheet. Dim oTG As TransientGeometry oTG = oApp.TransientGeometry 'This Drawing Document Select Set Dim oSelectset As SelectSet = oDoc.SelectSet oSelectset.Clear() Dim oSheet As Sheet = oDoc.ActiveSheet Dim oViews As DrawingViews = oActiveSheet.DrawingViews Dim oView As DrawingView = oSheet.DrawingViews.Item(1) ' Assuming you're working with the first view For Each oView In oViews oSelectset.Select(oView) 'Get the lowest Y position of all dimensions on the drawing sheet Dim lowestY As Double = GetLowestDimensionY(oSheet) 'Get the label associated with the view Dim oLabel As DrawingViewLabel = oView.Label 'Define the new position for the label Dim newX As Double = oLabel.Position.X Dim newY As Double = lowestY - 1 ' Adjust this value as needed for spacing Dim oPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(newX, newY) 'Move the label to the new position oLabel.Position = oPoint 'Refresh the drawing to see the changes oSheet.Update() Next iLogicVb.UpdateWhenDone = True End Sub Function GetLowestDimensionY(sheet As Sheet) As Double Dim lowestY As Double = Double.MaxValue For Each oDim As GeneralDimension In sheet.DrawingDimensions Dim dimPosition As Point2d = oDim.Text.Origin Dim dimY As Double = dimPosition.Y If dimY < lowestY Then lowestY = dimY End If Next Return lowestY End Function
Donald
Hi Again @Curtis_Waguespack
The rule you amended above will move the view label of the 1st base view only a set distance below the lowest dimension on the whole drawing. if there is another view, with dimensions (In the Y direction), that is lower then the base view the label of the base view will move below tat other view.
I have changed the rule (See below) to move all the view labels but its moving them all based on the rule dim above and places them in line with each other.
What I would like is the rule above to run on only 1 view at a time, and move the view label based on that view only.
i hope this is making sense?
new rule:
Public Sub Main Call RepositionDrawingViewLabels End Sub Private Sub RepositionDrawingViewLabels() 'Set a reference to the drawing document. 'This assumes a drawing document is active. Dim oApp = ThisApplication Dim oDoc As DrawingDocument oDoc = oApp.ActiveDocument 'Set a reference to the active sheet. Dim oActiveSheet As Sheet oActiveSheet = oDoc.ActiveSheet 'Set a reference to the TransientGeometry on active sheet. Dim oTG As TransientGeometry oTG = oApp.TransientGeometry 'This Drawing Document Select Set Dim oSelectset As SelectSet = oDoc.SelectSet oSelectset.Clear() Dim oSheet As Sheet = oDoc.ActiveSheet Dim oViews As DrawingViews = oActiveSheet.DrawingViews Dim oView As DrawingView = oSheet.DrawingViews.Item(1) ' Assuming you're working with the first view For Each oView In oViews oSelectset.Select(oView) 'Get the lowest Y position of all dimensions on the drawing sheet Dim lowestY As Double = GetLowestDimensionY(oSheet) 'Get the label associated with the view Dim oLabel As DrawingViewLabel = oView.Label 'Define the new position for the label Dim newX As Double = oLabel.Position.X Dim newY As Double = lowestY - 1 ' Adjust this value as needed for spacing Dim oPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(newX, newY) 'Move the label to the new position oLabel.Position = oPoint 'Refresh the drawing to see the changes oSheet.Update() Next iLogicVb.UpdateWhenDone = True End Sub Function GetLowestDimensionY(sheet As Sheet) As Double Dim lowestY As Double = Double.MaxValue For Each oDim As GeneralDimension In sheet.DrawingDimensions Dim dimPosition As Point2d = oDim.Text.Origin Dim dimY As Double = dimPosition.Y If dimY < lowestY Then lowestY = dimY End If Next Return lowestY End Function
Donald
I don't know if you found your answer, but I had a similar problem. this is what worked for me:
Sub Main()
Dim oDoc As DrawingDocument = ThisDoc.Document
Dim oSheet As Sheet = oDoc.ActiveSheet
For Each oView As DrawingView In oSheet.DrawingViews
Dim oViewLabel As DrawingViewLabel = oView.Label
Dim defaultY As Double = oView.Top - oView.Height
' Check for dimensions below the view
Dim lowestDimensionY As Double = defaultY
' Check for dimensions
For Each oDim As DrawingDimension In oSheet.DrawingDimensions
If IsDimensionAssociatedWithView(oDim, oView) AndAlso
IsDimensionTextUnderView(oDim, oView) Then
Dim dimTextY As Double = oDim.Text.Origin.Y
If dimTextY < lowestDimensionY Then
lowestDimensionY = dimTextY
End If
End If
Next
' Determine the final Y position for the label
Dim finalY As Double
If lowestDimensionY < defaultY Then
finalY = lowestDimensionY - oDoc.UnitsOfMeasure.ConvertUnits(2, kCentimeterLengthUnits, oDoc.UnitsOfMeasure.LengthUnits)
Else
finalY = defaultY - oDoc.UnitsOfMeasure.ConvertUnits(2, kCentimeterLengthUnits, oDoc.UnitsOfMeasure.LengthUnits)
End If
' Calculate the X position (centered horizontally)
Dim defaultX As Double = oView.Left + (oView.Width / 2)
' Create a new Point2D for the position
Dim newPosition As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(defaultX, finalY)
' Move the view label to the new position
oViewLabel.ConstrainToBorder = False
oViewLabel.Position = newPosition
Next
' Update the drawing and refresh the graphics
oDoc.Update()
ThisApplication.ActiveView.Update()
End Sub
Function IsDimensionAssociatedWithView(oDim As DrawingDimension, oView As DrawingView) As Boolean
' Check if the dimension is associated with the view
Dim intentOne As GeometryIntent = oDim.IntentOne
Dim intentTwo As GeometryIntent = oDim.IntentTwo
' Check if either of the intents' geometry belongs to the view
If (intentOne.Geometry IsNot Nothing AndAlso intentOne.Geometry.Parent Is oView) OrElse
(intentTwo.Geometry IsNot Nothing AndAlso intentTwo.Geometry.Parent Is oView) Then
Return True
End If
Return False
End Function
Function IsDimensionTextUnderView(oDim As DrawingDimension, oView As DrawingView) As Boolean
Dim dimTextOrigin As Point2d = oDim.Text.Origin
' Check if the dimension text is between the left and right extents of the view
If dimTextOrigin.X >= oView.Left AndAlso dimTextOrigin.X <= (oView.Left + oView.Width) Then
' Check if the dimension text is below the bottom of the view
If dimTextOrigin.Y < (oView.Top - oView.Height) Then
Return True
End If
End If
Return False
End Function
I don't know if you found your answer, but I had a similar problem. this is what worked for me:
Sub Main()
Dim oDoc As DrawingDocument = ThisDoc.Document
Dim oSheet As Sheet = oDoc.ActiveSheet
For Each oView As DrawingView In oSheet.DrawingViews
Dim oViewLabel As DrawingViewLabel = oView.Label
Dim defaultY As Double = oView.Top - oView.Height
' Check for dimensions below the view
Dim lowestDimensionY As Double = defaultY
' Check for dimensions
For Each oDim As DrawingDimension In oSheet.DrawingDimensions
If IsDimensionAssociatedWithView(oDim, oView) AndAlso
IsDimensionTextUnderView(oDim, oView) Then
Dim dimTextY As Double = oDim.Text.Origin.Y
If dimTextY < lowestDimensionY Then
lowestDimensionY = dimTextY
End If
End If
Next
' Determine the final Y position for the label
Dim finalY As Double
If lowestDimensionY < defaultY Then
finalY = lowestDimensionY - oDoc.UnitsOfMeasure.ConvertUnits(2, kCentimeterLengthUnits, oDoc.UnitsOfMeasure.LengthUnits)
Else
finalY = defaultY - oDoc.UnitsOfMeasure.ConvertUnits(2, kCentimeterLengthUnits, oDoc.UnitsOfMeasure.LengthUnits)
End If
' Calculate the X position (centered horizontally)
Dim defaultX As Double = oView.Left + (oView.Width / 2)
' Create a new Point2D for the position
Dim newPosition As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(defaultX, finalY)
' Move the view label to the new position
oViewLabel.ConstrainToBorder = False
oViewLabel.Position = newPosition
Next
' Update the drawing and refresh the graphics
oDoc.Update()
ThisApplication.ActiveView.Update()
End Sub
Function IsDimensionAssociatedWithView(oDim As DrawingDimension, oView As DrawingView) As Boolean
' Check if the dimension is associated with the view
Dim intentOne As GeometryIntent = oDim.IntentOne
Dim intentTwo As GeometryIntent = oDim.IntentTwo
' Check if either of the intents' geometry belongs to the view
If (intentOne.Geometry IsNot Nothing AndAlso intentOne.Geometry.Parent Is oView) OrElse
(intentTwo.Geometry IsNot Nothing AndAlso intentTwo.Geometry.Parent Is oView) Then
Return True
End If
Return False
End Function
Function IsDimensionTextUnderView(oDim As DrawingDimension, oView As DrawingView) As Boolean
Dim dimTextOrigin As Point2d = oDim.Text.Origin
' Check if the dimension text is between the left and right extents of the view
If dimTextOrigin.X >= oView.Left AndAlso dimTextOrigin.X <= (oView.Left + oView.Width) Then
' Check if the dimension text is below the bottom of the view
If dimTextOrigin.Y < (oView.Top - oView.Height) Then
Return True
End If
End If
Return False
End Function
Yeah I didn't really give it robust handling for multiple annotation types. I'll have to look into it and see how to improve it... sorry!
Yeah I didn't really give it robust handling for multiple annotation types. I'll have to look into it and see how to improve it... sorry!
No need to be sorry, Thanks for helping out. I'll have a look at it and see if I can sort it out also, But I'm not that advanced yet lol
No need to be sorry, Thanks for helping out. I'll have a look at it and see if I can sort it out also, But I'm not that advanced yet lol
Here is the revised code.
Sub Main() Dim oDoc As DrawingDocument = ThisDoc.Document Dim oSheet As Sheet = oDoc.ActiveSheet ' Iterate through each view in the active sheet For Each oView As DrawingView In oSheet.DrawingViews Dim oViewLabel As DrawingViewLabel = oView.Label Dim defaultY As Double = oView.Top - oView.Height ' Initialize a variable to track the lowest dimension Y position under the view Dim lowestDimensionY As Double = defaultY ' Check each dimension in the sheet For Each oDim As DrawingDimension In oSheet.DrawingDimensions ' Check if the dimension is associated with the current view and if its text is below the view If IsDimensionAssociatedWithView(oDim, oView) AndAlso IsDimensionTextUnderView(oDim, oView) Then Dim dimTextY As Double = oDim.Text.Origin.Y ' Find the lowest dimension text Y-coordinate If dimTextY < lowestDimensionY Then lowestDimensionY = dimTextY End If End If Next ' Determine the final Y position for the label Dim finalY As Double If lowestDimensionY < defaultY Then finalY = lowestDimensionY - 1 ' Adjust the label's Y position slightly below the lowest dimension Else finalY = defaultY - 1 ' Adjust slightly below the view's default Y position End If ' Calculate the X position (centered horizontally relative to the view) Dim defaultX As Double = oView.Left + (oView.Width / 2) ' Create a new Point2D for the label position Dim newPosition As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(defaultX, finalY) ' Update the view label position oViewLabel.ConstrainToBorder = False oViewLabel.Position = newPosition Next ' Update the drawing and refresh the view oDoc.Update() ThisApplication.ActiveView.Update() End Sub ' Function to check if the dimension is associated with the given view Function IsDimensionAssociatedWithView(oDim As DrawingDimension, oView As DrawingView) As Boolean Try ' For linear and angular dimensions, use IntentOne and IntentTwo Dim intentOne As GeometryIntent = oDim.IntentOne Dim intentTwo As GeometryIntent = oDim.IntentTwo ' Check if either geometry intent belongs to the view If (intentOne IsNot Nothing AndAlso intentOne.Geometry IsNot Nothing AndAlso intentOne.Geometry.Parent Is oView) OrElse (intentTwo IsNot Nothing AndAlso intentTwo.Geometry IsNot Nothing AndAlso intentTwo.Geometry.Parent Is oView) Then Return True End If Catch ex As Exception ' Handle exceptions, especially for dimensions that do not have IntentOne and IntentTwo End Try Return False End Function ' Function to check if the dimension's text is below the view Function IsDimensionTextUnderView(oDim As DrawingDimension, oView As DrawingView) As Boolean Dim dimTextOrigin As Point2d = oDim.Text.Origin ' Check if the dimension text is horizontally within the view's extents If dimTextOrigin.X >= oView.Left AndAlso dimTextOrigin.X <= (oView.Left + oView.Width) Then ' Check if the dimension text is below the bottom of the view If dimTextOrigin.Y < (oView.Top - oView.Height) Then Return True End If End If Return False End Function
Here is the revised code.
Sub Main() Dim oDoc As DrawingDocument = ThisDoc.Document Dim oSheet As Sheet = oDoc.ActiveSheet ' Iterate through each view in the active sheet For Each oView As DrawingView In oSheet.DrawingViews Dim oViewLabel As DrawingViewLabel = oView.Label Dim defaultY As Double = oView.Top - oView.Height ' Initialize a variable to track the lowest dimension Y position under the view Dim lowestDimensionY As Double = defaultY ' Check each dimension in the sheet For Each oDim As DrawingDimension In oSheet.DrawingDimensions ' Check if the dimension is associated with the current view and if its text is below the view If IsDimensionAssociatedWithView(oDim, oView) AndAlso IsDimensionTextUnderView(oDim, oView) Then Dim dimTextY As Double = oDim.Text.Origin.Y ' Find the lowest dimension text Y-coordinate If dimTextY < lowestDimensionY Then lowestDimensionY = dimTextY End If End If Next ' Determine the final Y position for the label Dim finalY As Double If lowestDimensionY < defaultY Then finalY = lowestDimensionY - 1 ' Adjust the label's Y position slightly below the lowest dimension Else finalY = defaultY - 1 ' Adjust slightly below the view's default Y position End If ' Calculate the X position (centered horizontally relative to the view) Dim defaultX As Double = oView.Left + (oView.Width / 2) ' Create a new Point2D for the label position Dim newPosition As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(defaultX, finalY) ' Update the view label position oViewLabel.ConstrainToBorder = False oViewLabel.Position = newPosition Next ' Update the drawing and refresh the view oDoc.Update() ThisApplication.ActiveView.Update() End Sub ' Function to check if the dimension is associated with the given view Function IsDimensionAssociatedWithView(oDim As DrawingDimension, oView As DrawingView) As Boolean Try ' For linear and angular dimensions, use IntentOne and IntentTwo Dim intentOne As GeometryIntent = oDim.IntentOne Dim intentTwo As GeometryIntent = oDim.IntentTwo ' Check if either geometry intent belongs to the view If (intentOne IsNot Nothing AndAlso intentOne.Geometry IsNot Nothing AndAlso intentOne.Geometry.Parent Is oView) OrElse (intentTwo IsNot Nothing AndAlso intentTwo.Geometry IsNot Nothing AndAlso intentTwo.Geometry.Parent Is oView) Then Return True End If Catch ex As Exception ' Handle exceptions, especially for dimensions that do not have IntentOne and IntentTwo End Try Return False End Function ' Function to check if the dimension's text is below the view Function IsDimensionTextUnderView(oDim As DrawingDimension, oView As DrawingView) As Boolean Dim dimTextOrigin As Point2d = oDim.Text.Origin ' Check if the dimension text is horizontally within the view's extents If dimTextOrigin.X >= oView.Left AndAlso dimTextOrigin.X <= (oView.Left + oView.Width) Then ' Check if the dimension text is below the bottom of the view If dimTextOrigin.Y < (oView.Top - oView.Height) Then Return True End If End If Return False End Function
Can't find what you're looking for? Ask the community or share your knowledge.