This rule is taken from my blog. (www.hjalte.nl) There you will also find other rules that will auto-dimension holes and bend dimensions.
Public Class ThisRule
' This code was written by Jelte de Jong
' and published on www.hjalte.nl
Private _doc As DrawingDocument
Private _sheet As Sheet
Private _view As DrawingView
Private _intents As List(Of GeometryIntent) = New List(Of GeometryIntent)()
Sub Main()
_doc = ThisDoc.Document
_sheet = _doc.ActiveSheet
_view = ThisApplication.CommandManager.Pick(
SelectionFilterEnum.kDrawingViewFilter,
"Select a drawing view")
CreateIntentList()
createHorizontalOuterDimension()
createVerticalOuterDimension()
End Sub
Private Sub createHorizontalOuterDimension()
Dim orderedIntents = _intents.OrderByDescending(Function(s) s.PointOnSheet.X)
Dim pointLeft = orderedIntents.First
Dim pointRight = orderedIntents.Last
Dim textX = pointLeft.PointOnSheet.X +
(pointRight.PointOnSheet.X - pointLeft.PointOnSheet.X) / 2
Dim textY = _view.Position.Y + _view.Height / 2 + 2
Dim pointText = ThisApplication.TransientGeometry.CreatePoint2d(textX, textY)
_sheet.DrawingDimensions.GeneralDimensions.AddLinear(
pointText, pointLeft, pointRight, DimensionTypeEnum.kHorizontalDimensionType)
End Sub
Private Sub createVerticalOuterDimension()
Dim orderedIntents = _intents.OrderByDescending(Function(s) s.PointOnSheet.Y)
Dim pointLeft = orderedIntents.Last
Dim pointRight = orderedIntents.First
Dim textY = pointLeft.PointOnSheet.Y +
(pointRight.PointOnSheet.Y - pointLeft.PointOnSheet.Y) / 2
Dim textX = _view.Position.X - _view.Width / 2 - 2
Dim pointText = ThisApplication.TransientGeometry.CreatePoint2d(textX, textY)
_sheet.DrawingDimensions.GeneralDimensions.AddLinear(
pointText, pointLeft, pointRight, DimensionTypeEnum.kVerticalDimensionType)
End Sub
Private Sub addIntent(Geometry As DrawingCurve, IntentPlace As Object, onLineCheck As Boolean)
Dim intent As GeometryIntent = _sheet.CreateGeometryIntent(Geometry, IntentPlace)
If intent.PointOnSheet Is Nothing Then Return
If onLineCheck Then
If (IntentIsOnCurve(intent)) Then
_intents.Add(intent)
End If
Else
_intents.Add(intent)
End If
End Sub
Private Function IntentIsOnCurve(intent As GeometryIntent) As Boolean
Dim Geometry As DrawingCurve = intent.Geometry
Dim sp = intent.PointOnSheet
Dim pts(1) As Double
Dim gp() As Double = {}
Dim md() As Double = {}
Dim pm() As Double = {}
Dim st() As SolutionNatureEnum = {}
pts(0) = sp.X
pts(1) = sp.Y
Try
Geometry.Evaluator2D.GetParamAtPoint(pts, gp, md, pm, st)
Catch ex As Exception
Return False
End Try
Return True
End Function
Private Sub CreateIntentList()
For Each oDrawingCurve As DrawingCurve In _view.DrawingCurves
Select Case oDrawingCurve.ProjectedCurveType
Case _
Curve2dTypeEnum.kCircleCurve2d,
Curve2dTypeEnum.kCircularArcCurve2d,
Curve2dTypeEnum.kEllipseFullCurve2d,
Curve2dTypeEnum.kEllipticalArcCurve2d
addIntent(oDrawingCurve, PointIntentEnum.kCircularTopPointIntent, True)
addIntent(oDrawingCurve, PointIntentEnum.kCircularBottomPointIntent, True)
addIntent(oDrawingCurve, PointIntentEnum.kCircularLeftPointIntent, True)
addIntent(oDrawingCurve, PointIntentEnum.kCircularRightPointIntent, True)
addIntent(oDrawingCurve, PointIntentEnum.kEndPointIntent, False)
addIntent(oDrawingCurve, PointIntentEnum.kStartPointIntent, False)
Case _
Curve2dTypeEnum.kLineCurve2d,
Curve2dTypeEnum.kLineSegmentCurve2d
addIntent(oDrawingCurve, PointIntentEnum.kEndPointIntent, False)
addIntent(oDrawingCurve, PointIntentEnum.kStartPointIntent, False)
Case _
Curve2dTypeEnum.kPolylineCurve2d,
Curve2dTypeEnum.kBSplineCurve2d,
Curve2dTypeEnum.kUnknownCurve2d
' Unhandled curves types
Case Else
End Select
Next
End Sub
End Class
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

Blog: hjalte.nl - github.com