09-18-2024
04:05 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
09-18-2024
04:05 PM
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