Drawing Dimensions

ssyXENBT · ‎06-15-2023

Hi,

i'm trying to create drawings automatically and it's just stuck on the dimensioning.

I try to set the dimensions with points so that I always have the outermost dimensions.

the code looks like this:

        Dim oScale As Double = oView.Scale
        Dim oTraGeo As TransientGeometry = ivExe.TransientGeometry
        Dim oPoints As List(Of Point2d) = New List(Of Point2d)

        For Each oCurve As DrawingCurve In oDrawingCurves
            oPoints.Add(oCurve.StartPoint)
            oPoints.Add(oCurve.EndPoint)
        Next

        Dim smallestPointX_Old As Point2d = FindSmallestPointX(oPoints)
        Dim smallestPointY_Old As Point2d = FindSmallestPointY(oPoints)
        Dim farthestPointX_Old As Point2d = FindFarthestPointX(oPoints)
        Dim farthestPointY_Old As Point2d = FindFarthestPointY(oPoints)

        Dim oGeo1 As GeometryIntent = oSheet.CreateGeometryIntent(smallestPointX_Old)
        Dim oGeo2 As GeometryIntent = oSheet.CreateGeometryIntent(farthestPointX_Old)
        oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oTraGeo.CreatePoint2d(0, 0), oGeo1, oGeo2, DimensionTypeEnum.kAlignedDimensionType)

I search for the smallest point and largest point in X & Y, which are also found, but I always get the error on the last line (HRESULT: 0x80004005 (E_FAIL)))

Thanks for any reply!

dypro · ‎06-15-2023

Hello, @ssyXENBT this code, does what you want, it's supossed to also put the positions of holes and some more stuff (It doesn't work for me that part of the code, but perhaps it works to you???)
The code is from Jelte de Jong 's page

Public Class ThisRule

    Private _doc As DrawingDocument
    Private _sheet As Sheet
    Private _view As DrawingView
    Private _intents As List(Of GeometryIntent) = New List(Of GeometryIntent)()
    Private _centerPointIntents As List(Of GeometryIntent) = New List(Of GeometryIntent)()

    ' Some settings here for you to change. 
    Private _stackedDimensions As Boolean = False
    Private _firstOffset As Double = 1.2 'Cm
    Private _offsetDimension As Double = 0.6 'Cm

    Public Sub Main()
        _doc = ThisDoc.Document
        _sheet = _doc.ActiveSheet
        _view = ThisApplication.CommandManager.Pick(
                       SelectionFilterEnum.kDrawingViewFilter,
                       "Select a drawing view")

        Dim transaction As Transaction = ThisApplication.TransactionManager.StartTransaction(_doc, "Generate dimensions")
        CreateIntentList()

        ' Comment out features that you dont want/need!
        CreateHorizontalDimensions()
        CreateVerticalDimensions()
        CreateMarks()
        AddDiameterDimensionToCircles()
        ' createHorizontalOuterDimension()
        ' createVerticalOuterDimension()

        transaction.End()
    End Sub


    Public Sub CreateHorizontalDimensions()
        Dim orderedIntents = _intents.OrderBy(Function(s) s.PointOnSheet.X)
        Dim orderedCenterIntents = _centerPointIntents.OrderBy(Function(s) s.PointOnSheet.X)

        Dim pointLeft = orderedIntents.First
        Dim pointRight = Nothing
        Dim lastX = pointLeft.PointOnSheet.X
        Dim offset As Double = _firstOffset
        For Each intent As GeometryIntent In orderedCenterIntents
            pointRight = intent
            If (AreEqual(pointRight.PointOnSheet.X, lastX)) Then
                Continue For
            End If
            CreateHorizontalDimension(pointLeft, pointRight, offset)
            If _stackedDimensions Then
                offset = offset + _offsetDimension
            Else
                pointLeft = pointRight
            End If
            lastX = pointRight.PointOnSheet.X
        Next
        pointRight = orderedIntents.Last

        CreateHorizontalDimension(pointLeft, pointRight, offset)

    End Sub
    Private Sub CreateHorizontalDimension(pointLeft As GeometryIntent,
                                          pointRight As GeometryIntent,
                                          distanceFromView As Double)
        Dim textX = pointLeft.PointOnSheet.X +
                (pointRight.PointOnSheet.X - pointLeft.PointOnSheet.X) / 2
        Dim textY = _view.Position.Y + _view.Height / 2 + distanceFromView

        Dim pointText = ThisApplication.TransientGeometry.CreatePoint2d(textX, textY)
        _sheet.DrawingDimensions.GeneralDimensions.AddLinear(
            pointText, pointLeft, pointRight, DimensionTypeEnum.kHorizontalDimensionType)
    End Sub
    Private Sub CreateHorizontalOuterDimension()
        Dim orderedIntents = _intents.OrderByDescending(Function(s) s.PointOnSheet.X)

        Dim pointLeft = orderedIntents.First
        Dim pointRight = orderedIntents.Last

        CreateHorizontalDimension(pointLeft, pointRight, _firstOffset - _offsetDimension)
    End Sub

    Public Sub CreateVerticalDimensions()
        Dim orderedIntents = _intents.OrderByDescending(Function(s) s.PointOnSheet.Y)
        Dim orderedCenterIntents = _centerPointIntents.OrderByDescending(Function(s) s.PointOnSheet.Y)

        Dim pointLeft = orderedIntents.First
        Dim pointRight = Nothing
        Dim lastY = pointLeft.PointOnSheet.Y
        Dim offset As Double = _firstOffset
        For Each intent As GeometryIntent In orderedCenterIntents
            pointRight = intent
            If (AreEqual(pointRight.PointOnSheet.Y, lastY)) Then
                Continue For
            End If
            CreateVerticalDimension(pointLeft, pointRight, offset)
            If _stackedDimensions Then
                offset = offset + _offsetDimension
            Else
                pointLeft = pointRight
            End If
            lastY = pointRight.PointOnSheet.Y
        Next
        pointRight = orderedIntents.Last

        CreateVerticalDimension(pointLeft, pointRight, offset)

    End Sub

    Private Sub CreateMarks()
        Dim done As List(Of GeometryIntent) = New List(Of GeometryIntent)()
        Dim orderedCenterIntents = _centerPointIntents.OrderByDescending(Function(s) s.PointOnSheet.Y)
        Dim firstIntent = orderedCenterIntents(0)
        Dim secondIntent = Nothing
        For i = 1 To orderedCenterIntents.Count - 1
            secondIntent = orderedCenterIntents(i)
            If (AreEqual(firstIntent.PointOnSheet.Y, secondIntent.PointOnSheet.Y)) Then
                CreateCenterLine(firstIntent, secondIntent)
                done.Add(firstIntent)
                done.Add(secondIntent)
            End If
            firstIntent = secondIntent
        Next

        orderedCenterIntents = _centerPointIntents.OrderByDescending(Function(s) s.PointOnSheet.X)
        firstIntent = orderedCenterIntents(0)
        secondIntent = Nothing
        For i = 1 To orderedCenterIntents.Count - 1
            secondIntent = orderedCenterIntents(i)
            If (AreEqual(firstIntent.PointOnSheet.X, secondIntent.PointOnSheet.X)) Then
                CreateCenterLine(firstIntent, secondIntent)
                done.Add(firstIntent)
                done.Add(secondIntent)
            End If
            firstIntent = secondIntent
        Next

        For Each intent As GeometryIntent In orderedCenterIntents
            If (done.Contains(intent)) Then
                Continue For
            End If
            _sheet.Centermarks.Add(intent)
        Next

    End Sub
    Public Sub CreateCenterLine(pointLeft As GeometryIntent, pointRight As GeometryIntent)
        Dim collection = ThisApplication.TransientObjects.CreateObjectCollection()
        collection.Add(pointLeft)
        collection.Add(pointRight)
        _sheet.Centerlines.Add(collection)
    End Sub

    Private Sub CreateVerticalDimension(pointLeft As GeometryIntent,
                                        pointRight As GeometryIntent,
                                        distanceFromView As Double)

        Dim textY = pointLeft.PointOnSheet.Y +
                (pointRight.PointOnSheet.Y - pointLeft.PointOnSheet.Y) / 2
        Dim textX = _view.Position.X - _view.Width / 2 - distanceFromView

        Dim pointText = ThisApplication.TransientGeometry.CreatePoint2d(textX, textY)
        _sheet.DrawingDimensions.GeneralDimensions.AddLinear(
            pointText, pointLeft, pointRight, DimensionTypeEnum.kVerticalDimensionType)
    End Sub
    Private Sub CreateVerticalOuterDimension()
        Dim orderedIntents = _intents.OrderByDescending(Function(s) s.PointOnSheet.Y)

        Dim pointLeft = orderedIntents.Last
        Dim pointRight = orderedIntents.First

        CreateVerticalDimension(pointLeft, pointRight, _firstOffset - _offsetDimension)

    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 drawingCurve As DrawingCurve In _view.DrawingCurves
            Select Case DrawingCurve.ProjectedCurveType
                Case _
                        Curve2dTypeEnum.kCircleCurve2d,
                        Curve2dTypeEnum.kCircularArcCurve2d,
                        Curve2dTypeEnum.kEllipseFullCurve2d,
                        Curve2dTypeEnum.kEllipticalArcCurve2d

                    AddIntent(DrawingCurve, PointIntentEnum.kCircularTopPointIntent, True)
                    AddIntent(DrawingCurve, PointIntentEnum.kCircularBottomPointIntent, True)
                    AddIntent(DrawingCurve, PointIntentEnum.kCircularLeftPointIntent, True)
                    AddIntent(DrawingCurve, PointIntentEnum.kCircularRightPointIntent, True)

                    AddIntent(DrawingCurve, PointIntentEnum.kEndPointIntent, False)
                    AddIntent(DrawingCurve, PointIntentEnum.kStartPointIntent, False)

                    If (DrawingCurve.ProjectedCurveType = Curve2dTypeEnum.kCircleCurve2d) Then
                        Dim intent = _sheet.CreateGeometryIntent(DrawingCurve, PointIntentEnum.kCenterPointIntent)
                        _centerPointIntents.Add(intent)
                    End If
                Case _
                        Curve2dTypeEnum.kLineCurve2d,
                        Curve2dTypeEnum.kLineSegmentCurve2d

                    AddIntent(DrawingCurve, PointIntentEnum.kEndPointIntent, False)
                    AddIntent(DrawingCurve, PointIntentEnum.kStartPointIntent, False)

                Case _
                    Curve2dTypeEnum.kPolylineCurve2d,
                    Curve2dTypeEnum.kBSplineCurve2d,
                    Curve2dTypeEnum.kUnknownCurve2d

                    ' Unhandled curves types
                Case Else
            End Select
        Next
    End Sub


    Private Sub AddDiameterDimensionToCircles()
        For Each intent As GeometryIntent In _intents
            Dim geo = intent.Geometry
            If (geo.type <> ObjectTypeEnum.kDrawingCurveObject) Then
                Continue For
            End If
            Dim curve As DrawingCurve = geo
            If (curve.ProjectedCurveType <> Curve2dTypeEnum.kCircleCurve2d) Then
                Continue For
            End If
            Dim rangeBox = curve.Evaluator2D.RangeBox
            Dim radius = (rangeBox.MaxPoint.X - rangeBox.MinPoint.X) / 2
            Dim x = curve.CenterPoint.X + radius
            Dim y = curve.CenterPoint.Y + radius
            Dim textPoint = ThisApplication.TransientGeometry.CreatePoint2d(x, y)
            _sheet.DrawingDimensions.GeneralDimensions.AddDiameter(textPoint, intent)
        Next
    End Sub

    Private Function AreEqual(d1 As Double, d2 As Double)
        Return (Math.Abs(d1 - d2) < 0.000001)
    End Function

    ' Copyright 2021
    ' 
    ' This code was written by Jelte de Jong, and published on www.hjalte.nl
    '
    ' Permission Is hereby granted, free of charge, to any person obtaining a copy of this 
    ' software And associated documentation files (the "Software"), to deal in the Software 
    ' without restriction, including without limitation the rights to use, copy, modify, merge, 
    ' publish, distribute, sublicense, And/Or sell copies of the Software, And to permit persons 
    ' to whom the Software Is furnished to do so, subject to the following conditions:
    '
    ' The above copyright notice And this permission notice shall be included In all copies Or
    ' substantial portions Of the Software.
    ' 
    ' THE SOFTWARE Is PROVIDED "AS IS", WITHOUT WARRANTY Of ANY KIND, EXPRESS Or IMPLIED, 
    ' INCLUDING BUT Not LIMITED To THE WARRANTIES Of MERCHANTABILITY, FITNESS For A PARTICULAR 
    ' PURPOSE And NONINFRINGEMENT. In NO Event SHALL THE AUTHORS Or COPYRIGHT HOLDERS BE LIABLE 
    ' For ANY CLAIM, DAMAGES Or OTHER LIABILITY, WHETHER In AN ACTION Of CONTRACT, TORT Or 
    ' OTHERWISE, ARISING FROM, OUT Of Or In CONNECTION With THE SOFTWARE Or THE USE Or OTHER 
    ' DEALINGS In THE SOFTWARE.
End Class

ssyXENBT · ‎06-16-2023

Works great. I have adjusted a few things to my needs, but runs great now.

Thanks for the tip.

Community

Drawing Dimensions

Drawing Dimensions

Drawing Dimensions