09-16-2024
12:25 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
09-16-2024
12:25 PM
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