Dimensioning drawing view extents

[bshbsh]

Hi,

I'm trying to add the horizontal and the vertical extent dimensions to a flat pattern view, but so far  unsuccesfully. I'm pretty sure someone already has code for that... 🙂

I tried several approaches to find the outmost points, but my current approach is to intersect every drawing curve with the view boundary box lines to find the outmost points and create geometry intents on the found curve at the outermost point, to later add dimensions. But the problem is, sometimes the line2d.intersectwithcurve function does not return anything (unless using a huge tolerance, in which case it returns the wrong point) even though the curve does intersect with the line. Also, if the curve is a line parallel to the intersect line, it also doesn't return an intersection - but then how do I know if the lack of an intersection means a: there's indeed no intersection, or b: the two lines are parallel and coincident?

Anyway, some code showing how to do this would be helpful. Thanks!

Here's the current state of my code:

Private Function Extents(ByRef FlatPatternView As DrawingView)
    Dim TG, BG, LG, RG As GeometryIntent
    Set TG = Nothing
    Set BG = Nothing
    Set LG = Nothing
    Set RG = Nothing
    Dim UVH, UVV As UnitVector2d
    Set UVH = ThisApplication.TransientGeometry.CreateUnitVector2d(1, 0)
    Set UVV = ThisApplication.TransientGeometry.CreateUnitVector2d(0, 1)
    Dim TL, BL, LL, RL As Line2d
    Set TL = ThisApplication.TransientGeometry.CreateLine2d(ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left, FlatPatternView.Top), UVH)
    Set BL = ThisApplication.TransientGeometry.CreateLine2d(ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left, FlatPatternView.Top - FlatPatternView.Height), UVH)
    Set LL = ThisApplication.TransientGeometry.CreateLine2d(ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left, FlatPatternView.Top - FlatPatternView.Height), UVV)
    Set RL = ThisApplication.TransientGeometry.CreateLine2d(ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left + FlatPatternView.Width, FlatPatternView.Top - FlatPatternView.Height), UVV)
    For Each DrawingCurve In FlatPatternView.DrawingCurves
        If TG Is Nothing Then
            Set Intersect = TL.IntersectWithCurve(DrawingCurve.Segments.Item(1).Geometry)
            If Not (Intersect Is Nothing) Then Set TG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect.Item(1))
        End If
        If BG Is Nothing Then
            Set Intersect = BL.IntersectWithCurve(DrawingCurve.Segments.Item(1).Geometry)
            If Not (Intersect Is Nothing) Then Set BG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect.Item(1))
        End If
        If LG Is Nothing Then
            Set Intersect = LL.IntersectWithCurve(DrawingCurve.Segments.Item(1).Geometry)
            If Not (Intersect Is Nothing) Then Set LG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect.Item(1))
        End If
        If RG Is Nothing Then
            Set Intersect = RL.IntersectWithCurve(DrawingCurve.Segments.Item(1).Geometry)
            If Not (Intersect Is Nothing) Then Set RG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect.Item(1))
        End If
    Next
    Dim PT1 As Point2d
    Set PT1 = ThisApplication.TransientGeometry.CreatePoint2d
    PT1.X = FlatPatternView.Left - 1
    PT1.Y = FlatPatternView.Center.Y
    Set VDim = FlatPatternView.Parent.DrawingDimensions.GeneralDimensions.AddLinear(PT1, TG, BG, kVerticalDimensionType)
    PT1.X = FlatPatternView.Center.X
    PT1.Y = FlatPatternView.Top - FlatPatternView.Height - 1
    Set HDim = FlatPatternView.Parent.DrawingDimensions.GeneralDimensions.AddLinear(PT1, LG, RG, kHorizontalDimensionType)
End Function

Inv 2018

[Anonymous]

Hi, I use this code.

This is just a part code of some complete operations.

When an assembly is active I run my code, and it;

- creates an idw drawing,

- opens all sheet metals in assembly one by one

- if there is no flat pattern unfolds part

- sets the scale and places each part to seperate (A4) sheets as 2 views DrawingViews 

- creates range box dimensions for drawing views  (using the code below)

- if any; places bending lines & bend notes

- sets the label of base drawing view to show; flattened dimensions, thickness, material..

- create a table of hierarchy (sub assemblies that involve the part, and quantities)

- creates custom notes, arranges prompted title of sheet 

- sets sheet names, and finaly creates a sheet list

And then I manually do other things.

Hope that it will work for you too.

Sub CreateRangeBoxDimensionsOfDrawingView(oSheet As sheet, oDrawingView As DrawingView, Optional CreateHorizontalDimension As Boolean, Optional CreateVerticalDimension As Boolean)
    Dim oTransGeom      As TransientGeometry
    Dim oDrawSketch     As DrawingSketch
    
    'Left Top Corner
    Dim oLTC_X          As Double
    Dim oLTC_Y          As Double
    
    'Left Bottom Corner
    Dim oLBC_X          As Double
    Dim oLBC_Y          As Double
    
    'Right Top Corner
    Dim oRTC_X          As Double
    Dim oRTC_Y          As Double
    
    Dim oSketchLineVer    As SketchLine
    Dim oSketchLineHor    As SketchLine
    
    Dim oIntent1        As GeometryIntent
    Dim oIntent2        As GeometryIntent
    
    Dim oPt             As Point2d
    
    Dim oDimHor         As LinearGeneralDimension
    Dim oDimVer         As LinearGeneralDimension
    
    If CreateHorizontalDimension Or CreateVerticalDimension Then
        Set oTransGeom = ThisApplication.TransientGeometry
        
        With oDrawingView
                
            Set oDrawSketch = .Sketches.Add
                         
            oLTC_X = .Left - .Center.X             'left top corner x
            oLTC_Y = .Top - .Center.Y              'left top corner y
                            
            oLBC_X = .Left - .Center.X             'left bottom corner x
            oLBC_Y = .Top - .height - .Center.Y    'left bottom corner y
        
            oRTC_X = .Left + .width - .Center.X     'right top corner x
            oRTC_Y = .Top - .Center.Y              'right top corner y
            
            If CreateHorizontalDimension = True Then
                oDrawSketch.Edit
                
                Set oSketchLineHor = oDrawSketch.SketchLines.AddByTwoPoints( _
                        oTransGeom.CreatePoint2d(oLTC_X, oLTC_Y), _
                        oTransGeom.CreatePoint2d(oRTC_X, oRTC_Y))
                oSketchLineHor.LineType = kLongDashedDoubleDottedLineType
                
                oDrawSketch.ExitEdit
                
                Set oIntent1 = oSheet.CreateGeometryIntent(oDrawSketch.SketchLines.item(1), kStartPointIntent)
                Set oIntent2 = oSheet.CreateGeometryIntent(oDrawSketch.SketchLines.item(1), kEndPointIntent)
                
                Set oPt = oTransGeom.CreatePoint2d(.Center.X, .Top + .height / 10#)
                Set oDimHor = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPt, oIntent1, oIntent2, kAlignedDimensionType)
            End If
                    
            If CreateVerticalDimension = True Then
                oDrawSketch.Edit
                
                Set oSketchLineVer = oDrawSketch.SketchLines.AddByTwoPoints( _
                        oTransGeom.CreatePoint2d(oLTC_X, oLTC_Y), _
                        oTransGeom.CreatePoint2d(oLBC_X, oLBC_Y))
                oSketchLineVer.LineType = kLongDashedDoubleDottedLineType
                
                oDrawSketch.ExitEdit
                
                Set oIntent1 = oSheet.CreateGeometryIntent(oDrawSketch.SketchLines.item(IIf(CreateHorizontalDimension, 2, 1)), kStartPointIntent)
                Set oIntent2 = oSheet.CreateGeometryIntent(oDrawSketch.SketchLines.item(IIf(CreateHorizontalDimension, 2, 1)), kEndPointIntent)
    
                Set oPt = oTransGeom.CreatePoint2d(.Left - .width / 10#, .Center.Y)
        
                Set oDimVer = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPt, oIntent1, oIntent2, kAlignedDimensionType)
            End If
                
            
        End With
    End If
    
End Sub

[bshbsh]

Hey,

thanks for the reply. But I do not want to dimension sketches - are those associative at all? I do not want any sketches.

But I've made some progress. Now it does occassionally work, but I'm getting kinda unexpected results. I have added some visualisation (purely for testing purposes, these won't be in the code later.) The code now colors which drawing curves it found to have intersection with the view border basically, and also draws a circle where this intersection point is. But when I add the dimension and the intent is on a circular curve, the dimension will be created between the centerpoints, instead of the supplied point type intent. (See screenshot.) Why is taht and how to fix it?

Here's the code (uncomment the lines if you want to have these "visual aids")

Private Function AddExtentDims(ByRef FlatPatternView As DrawingView)
    Dim LT As Point2d, RT As Point2d, LB As Point2d, RB As Point2d
    Set LT = ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left, FlatPatternView.Top)
    Set RT = ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left + FlatPatternView.Width, FlatPatternView.Top)
    Set LB = ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left, FlatPatternView.Top - FlatPatternView.Height)
    Set RB = ThisApplication.TransientGeometry.CreatePoint2d(FlatPatternView.Left + FlatPatternView.Width, FlatPatternView.Top - FlatPatternView.Height)
    Dim TL As LineSegment2d, BL As LineSegment2d, LL As LineSegment2d, RL As LineSegment2d
    Set TL = ThisApplication.TransientGeometry.CreateLineSegment2d(LT, RT)
    Set BL = ThisApplication.TransientGeometry.CreateLineSegment2d(LB, RB)
    Set LL = ThisApplication.TransientGeometry.CreateLineSegment2d(LT, LB)
    Set RL = ThisApplication.TransientGeometry.CreateLineSegment2d(RT, RB)
    Dim TG As GeometryIntent, BG As GeometryIntent, LG As GeometryIntent, RG As GeometryIntent
    Set TG = Nothing
    Set BG = Nothing
    Set LG = Nothing
    Set RG = Nothing
    'Set Red = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
    'Set Green = ThisApplication.TransientObjects.CreateColor(0, 255, 0)
    'Set Blue = ThisApplication.TransientObjects.CreateColor(0, 0, 255)
    'Set Orange = ThisApplication.TransientObjects.CreateColor(255, 100, 0)
    'Set Magenta = ThisApplication.TransientObjects.CreateColor(255, 0, 255)
    'Set Yellow = ThisApplication.TransientObjects.CreateColor(255, 255, 0)
    'Set Gray_ = ThisApplication.TransientObjects.CreateColor(128, 128, 128)
    'Dim SK As DrawingSketch
    'Set SK = FlatPatternView.Sketches.Add
    'SK.Edit
    'Set CM = SK.SketchLines.AddAsTwoPointRectangle(SK.SheetToSketchSpace(LT), SK.SheetToSketchSpace(RB))
    'For Each Item In CM
    '    Item.OverrideColor = Yellow
    'Next
    'SK.ExitEdit
    Dim Intersect As Point2d
    For Each DrawingCurve In FlatPatternView.DrawingCurves
        'DrawingCurve.Color = Gray_
        'SK.Edit
        'Set CM = SK.SketchLines.AddAsTwoPointRectangle(SK.SheetToSketchSpace(DrawingCurve.Evaluator2D.RangeBox.MinPoint), SK.SheetToSketchSpace(DrawingCurve.Evaluator2D.RangeBox.MaxPoint))
        'For Each Item In CM
        '    Item.OverrideColor = Orange
        'Next
        'SK.ExitEdit
        If TG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, TL)
            If Not (Intersect Is Nothing) Then
                Set TG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                'DrawingCurve.Color = Red
                'SK.Edit
                'Set CM = SK.SketchCircles.AddByCenterRadius(SK.SheetToSketchSpace(TG.PointOnSheet), 0.1)
                'CM.OverrideColor = Red
                'SK.ExitEdit
            End If
        End If
        If BG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, BL)
            If Not (Intersect Is Nothing) Then
                Set BG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                'DrawingCurve.Color = Green
                'SK.Edit
                'Set CM = SK.SketchCircles.AddByCenterRadius(SK.SheetToSketchSpace(BG.PointOnSheet), 0.1)
                'CM.OverrideColor = Green
                'SK.ExitEdit
            End If
        End If
        If LG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, LL)
            If Not (Intersect Is Nothing) Then
                Set LG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                'DrawingCurve.Color = Blue
                'SK.Edit
                'Set CM = SK.SketchCircles.AddByCenterRadius(SK.SheetToSketchSpace(LG.PointOnSheet), 0.1)
                'CM.OverrideColor = Blue
                'SK.ExitEdit
            End If
        End If
        If RG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, RL)
            If Not (Intersect Is Nothing) Then
                Set RG = FlatPatternView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                'DrawingCurve.Color = Magenta
                'SK.Edit
                'Set CM = SK.SketchCircles.AddByCenterRadius(SK.SheetToSketchSpace(RG.PointOnSheet), 0.1)
                'CM.OverrideColor = Magenta
                'SK.ExitEdit
            End If
        End If
    Next
    Dim PT1 As Point2d
    Set PT1 = ThisApplication.TransientGeometry.CreatePoint2d
    If (Not TG Is Nothing) And (Not BG Is Nothing) Then
        PT1.X = FlatPatternView.Left - 0.5
        PT1.Y = FlatPatternView.Center.Y
        Set VDim = FlatPatternView.Parent.DrawingDimensions.GeneralDimensions.AddLinear(PT1, TG, BG, kVerticalDimensionType)
    End If
    If (Not LG Is Nothing) And (Not RG Is Nothing) Then
        PT1.X = FlatPatternView.Center.X
        PT1.Y = FlatPatternView.Top - FlatPatternView.Height - 1
        Set HDim = FlatPatternView.Parent.DrawingDimensions.GeneralDimensions.AddLinear(PT1, LG, RG, kHorizontalDimensionType)
    End If
End Function
Private Function GetIntersection(ByVal DC As DrawingCurve, ByVal L2D As LineSegment2d) As Point2d
    Dim Tol As Double
    Tol = 0.001
    Dim GI As Variant
    Set GI = Nothing
    For Each Item In DC.Segments
        If GI Is Nothing Then
            Set GI = L2D.IntersectWithCurve(Item.Geometry, Tol)
        Else
            Exit For
        End If
    Next
    If GI Is Nothing Then
        If (DC.CurveType = kLineCurve) Or (DC.CurveType = kLineSegmentCurve) Then
            If L2D.DistanceTo(DC.StartPoint) <= Tol Then
                Set GetIntersection = DC.StartPoint
            Else
                If L2D.DistanceTo(DC.EndPoint) <= Tol Then
                    Set GetIntersection = DC.EndPoint
                End If
            End If
        End If
    Else
        Set GetIntersection = GI.Item(1)
    End If
End Function

[Anonymous · Accepted solution]

Good job. 

May be for some curvy geometries you can use;

Dim oIntent1 As GeometryIntent
    Set oIntent1 = oDrawDoc.ActiveSheet.CreateGeometryIntent(oCurve, PointIntentEnum.kXXX)
    'PointIntentEnum.kTopMiddlePointIntent
    'PointIntentEnum.kLeftMiddlePointIntent
    'PointIntentEnum.kBottomMiddlePointIntent
    'PointIntentEnum.kRightMiddlePointIntent
    

[bshbsh]

Awesome, many thanks! I didn't know of this.

Here's the (so far) final code if anyone needs it.

Private Function AddExtentDimensions(ByRef DView As DrawingView)
    Dim LT As Point2d, RT As Point2d, LB As Point2d, RB As Point2d
    Set LT = ThisApplication.TransientGeometry.CreatePoint2d(DView.Left, DView.Top)
    Set RT = ThisApplication.TransientGeometry.CreatePoint2d(DView.Left + DView.Width, DView.Top)
    Set LB = ThisApplication.TransientGeometry.CreatePoint2d(DView.Left, DView.Top - DView.Height)
    Set RB = ThisApplication.TransientGeometry.CreatePoint2d(DView.Left + DView.Width, DView.Top - DView.Height)
    Dim TL As LineSegment2d, BL As LineSegment2d, LL As LineSegment2d, RL As LineSegment2d
    Set TL = ThisApplication.TransientGeometry.CreateLineSegment2d(LT, RT)
    Set BL = ThisApplication.TransientGeometry.CreateLineSegment2d(LB, RB)
    Set LL = ThisApplication.TransientGeometry.CreateLineSegment2d(LT, LB)
    Set RL = ThisApplication.TransientGeometry.CreateLineSegment2d(RT, RB)
    Dim TG As GeometryIntent, BG As GeometryIntent, LG As GeometryIntent, RG As GeometryIntent
    Set TG = Nothing
    Set BG = Nothing
    Set LG = Nothing
    Set RG = Nothing
    Dim Intersect As Point2d
    For Each DrawingCurve In DView.DrawingCurves
        If TG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, TL)
            If Not (Intersect Is Nothing) Then
                Select Case DrawingCurve.CurveType
                    Case kCircleCurve, kCircularArcCurve, kEllipseFullCurve, kEllipticalArcCurve
                        Set TG = DView.Parent.CreateGeometryIntent(DrawingCurve, kCircularTopPointIntent)
                    Case Else
                        Set TG = DView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                End Select
            End If
        End If
        If BG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, BL)
            If Not (Intersect Is Nothing) Then
                Select Case DrawingCurve.CurveType
                    Case kCircleCurve, kCircularArcCurve, kEllipseFullCurve, kEllipticalArcCurve
                        Set BG = DView.Parent.CreateGeometryIntent(DrawingCurve, kCircularBottomPointIntent)
                    Case Else
                        Set BG = DView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                End Select
            End If
        End If
        If LG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, LL)
            If Not (Intersect Is Nothing) Then
                Select Case DrawingCurve.CurveType
                    Case kCircleCurve, kCircularArcCurve, kEllipseFullCurve, kEllipticalArcCurve
                        Set LG = DView.Parent.CreateGeometryIntent(DrawingCurve, kCircularLeftPointIntent)
                    Case Else
                        Set LG = DView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                End Select
            End If
        End If
        If RG Is Nothing Then
            Set Intersect = GetIntersection(DrawingCurve, RL)
            If Not (Intersect Is Nothing) Then
                Select Case DrawingCurve.CurveType
                    Case kCircleCurve, kCircularArcCurve, kEllipseFullCurve, kEllipticalArcCurve
                        Set RG = DView.Parent.CreateGeometryIntent(DrawingCurve, kCircularRightPointIntent)
                    Case Else
                        Set RG = DView.Parent.CreateGeometryIntent(DrawingCurve, Intersect)
                End Select
            End If
        End If
    Next
    
    Dim PT1 As Point2d
    Set PT1 = ThisApplication.TransientGeometry.CreatePoint2d
    If (Not TG Is Nothing) And (Not BG Is Nothing) Then
        PT1.X = DView.Left - 0.75
        PT1.Y = DView.Center.Y
        Set VDim = DView.Parent.DrawingDimensions.GeneralDimensions.AddLinear(PT1, TG, BG, kVerticalDimensionType)
    End If
    If (Not LG Is Nothing) And (Not RG Is Nothing) Then
        PT1.X = DView.Center.X
        PT1.Y = DView.Top - DView.Height - 1
        Set HDim = DView.Parent.DrawingDimensions.GeneralDimensions.AddLinear(PT1, LG, RG, kHorizontalDimensionType)
    End If
End Function
Private Function GetIntersection(ByVal DC As DrawingCurve, ByVal L2D As LineSegment2d) As Point2d
    Dim Tol As Double
    Tol = 0.001
    Dim DS As Double, DE As Double
    Dim GI As Variant
    Set GI = Nothing
    For Each Item In DC.Segments
        If GI Is Nothing Then
            Set GI = L2D.IntersectWithCurve(Item.Geometry, Tol)
        Else
            Exit For
        End If
    Next
    If GI Is Nothing Then
        If (DC.CurveType = kLineCurve) Or (DC.CurveType = kLineSegmentCurve) Then
            DS = L2D.DistanceTo(DC.StartPoint)
            DE = L2D.DistanceTo(DC.EndPoint)
            If DS <= Tol Then
                Set GetIntersection = DC.StartPoint
            Else
                If DE <= Tol Then
                    Set GetIntersection = DC.EndPoint
                End If
            End If
        End If
    Else
        Set GetIntersection = GI.Item(1)
    End If
End Function

[Anonymous]

Thanks.

If you look at the image (created by your last code) that is attached to this post.. it is not ok yet, but will be.

May be you must specify four more GeometryIntent and set first group only for linear segments, and second group only for curvy  segments, and check them if they are inside the rectangular extent box.. finaly eliminate some of them and using remaining four intents create horizontal and vertical dimensions. Or try somethng else, but I believe that you will soon find the perfect way that fits all types of flat geometry.

[Anonymous]

Give a try to this code.. It isn't finished but it is clear that what to do next.

Thanks. Your idea was really breeder reactor: to be associative..

Sub TryGeometryIntentsList()

    Dim oDocActive As Document
    Set oDocActive = ThisApplication.ActiveDocument
         
    If oDocActive.DocumentType = kDrawingDocumentObject Then
        Dim drawView As DrawingView
        
        Set drawView = ThisApplication.CommandManager.Pick( _
                 kDrawingViewFilter, "Ölçülendirmek istediğiniz DrawingView için seçim yapın..")
       
        If drawView Is Nothing Then Exit Sub
            
        BGS drawView
    Else
        MsgBox "Bu makro IDW çizim dosyası aktifken kullanılır." & vbCrLf & "H.KILIÇ"
    End If
End Sub

Sub AddGI(ByRef oGeometryIntents() As GeometryIntent, oGeometryIntent As GeometryIntent)
    ReDim Preserve oGeometryIntents(UBound(oGeometryIntents) + 1)
    Set oGeometryIntents(UBound(oGeometryIntents)) = oGeometryIntent
End Sub

Sub BGS(oDrawingView As DrawingView)

    Dim oGeometryIntents()  As GeometryIntent
    Dim oGI                 As GeometryIntent
    ReDim oGeometryIntents(0 To 0)
    
    Dim oDrawingCurve As DrawingCurve
    For Each oDrawingCurve In oDrawingView.DrawingCurves
        Select Case oDrawingCurve.CurveType
            Case _
                    CurveTypeEnum.kCircleCurve, _
                    CurveTypeEnum.kCircularArcCurve, _
                    CurveTypeEnum.kEllipseFullCurve, _
                    CurveTypeEnum.kEllipticalArcCurve:
                    
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kCircularBottomPointIntent)
                AddGI oGeometryIntents, oGI
                
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kCircularLeftPointIntent)
                AddGI oGeometryIntents, oGI
                
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kCircularRightPointIntent)
                AddGI oGeometryIntents, oGI
                
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kCircularTopPointIntent)
                AddGI oGeometryIntents, oGI
                
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kEndPointIntent)
                AddGI oGeometryIntents, oGI
                
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kStartPointIntent)
                AddGI oGeometryIntents, oGI
                
            Case _
                    CurveTypeEnum.kLineCurve, _
                    CurveTypeEnum.kLineSegmentCurve:
                    
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kEndPointIntent)
                AddGI oGeometryIntents, oGI
                
                Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kStartPointIntent)
                AddGI oGeometryIntents, oGI
                
            Case CurveTypeEnum.kPolylineCurve:
                MsgBox ("Polyline") 'reserved for later
            Case CurveTypeEnum.kBSplineCurve:
                MsgBox ("BSpline") 'reserved for later
            Case CurveTypeEnum.kUnknownCurve:
                MsgBox ("Unknown") 'reserved for later
            Case Else:
            
        End Select
    Next oDrawingCurve
    
    'First: Draw Bounding Box
    Dim LeftTop         As Point2d
    Dim RightBottom     As Point2d

    Set LeftTop = ThisApplication.TransientGeometry.CreatePoint2d(oDrawingView.Left, oDrawingView.Top)
    Set RightBottom = ThisApplication.TransientGeometry.CreatePoint2d(oDrawingView.Left + oDrawingView.width, oDrawingView.Top - oDrawingView.height)
    
    Dim oDrawingSketchBorder As DrawingSketch
    Set oDrawingSketchBorder = oDrawingView.Sketches.Add
    oDrawingSketchBorder.name = "Sketch Border"
    
    oDrawingSketchBorder.Edit
    
        Dim oSketchEntities As SketchEntitiesEnumerator
        Set oSketchEntities = oDrawingSketchBorder.SketchLines.AddAsTwoPointRectangle(oDrawingSketchBorder.SheetToSketchSpace(LeftTop), oDrawingSketchBorder.SheetToSketchSpace(RightBottom))

        Dim item As Variant
        For Each item In oSketchEntities
            item.OverrideColor = ThisApplication.TransientObjects.CreateColor(0, 255, 0)
        Next
   
   oDrawingSketchBorder.ExitEdit

    
    'Second: Draw Intent Points
    Dim oDrawingSketchPoints As DrawingSketch
    Set oDrawingSketchPoints = oDrawingView.Sketches.Add
    oDrawingSketchPoints.name = "Sketch Points"
    
    oDrawingSketchPoints.Edit
    Dim i As Integer
    For i = 1 To UBound(oGeometryIntents)
        Dim oSketchCircle As SketchCircle
        If Not oGeometryIntents(i).PointOnSheet Is Nothing Then
            Set oSketchCircle = oDrawingSketchPoints.SketchCircles.AddByCenterRadius(oDrawingSketchPoints.SheetToSketchSpace(oGeometryIntents(i).PointOnSheet), 0.2)
        End If
        oSketchCircle.LineWeight = 0.5
        oSketchCircle.OverrideColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
    Next i
    oDrawingSketchPoints.ExitEdit
    
    'Third: Iterate through oGeometryIntents() and eliminate points outside of border
    'Specify LeftIntent, RightIntent, BottomIntent, TopIntent using remaining Intents of list array
    'RightIntent and BottomIntent may share same object, and so..
    'Decide the side and position of horizontal and vertical dimensions according to specified intent positions relative to center point of border
    
End Sub

[YUGANATHAN23]

Why cannot copy paste

[floccipier]

@bshbsh thanks for this code, any idea why sometimes this would miss adding dimenions?

best regards, 

floflo

[bshbsh]

Because it is just a bad code? 😄 Sorry I didn't work on this ever since, it works 99% for us and the 1% is up to the user to fix, I can't be arsed anymore. It seems to be a lot of work to make this "bulletproof" for any case.

[floccipier]

@bshbsh I totally understand what you means and my questions was just a try to understand why this is happening. 

I have tried it in few different scenarios and it happens so that it adds dimensions on flat pattern ALWAYS but sometime will miss folded pattern Front and Side view. 

nevertheless, thanks again. 

[bshbsh]

---

@floccipier wrote:

I have tried it in few different scenarios and it happens so that it adds dimensions on flat pattern ALWAYS but sometime will miss folded pattern Front and Side view. 

---

well, the code is MEANT to do flat pattern views only. I have never tested it on anything else .

[floccipier]

Thanks for clearing this up and for flat patterns it works flawlessly everytime.

[floccipier]

just found this:
http://hjalte.nl/37-auto-overall-dimension

[bshbsh]

---

for flat patterns it works flawlessly everytime.

---

oh no, it doesn't. 🙂

[floccipier]

---

@bshbsh wrote:

---

for flat patterns it works flawlessly everytime.

---

oh no, it doesn't. 🙂

---

I was referring to your code and for all the drawings (I definitely used it on hundreds if not thousands of sheet metal)  it worked perfectly but you could be right too if it gives errors. 

[Maxim-CADman77]

Dear @JelteDeJong 
Message 14 references your code which produces wrong result if Drawing View contains definition of some child Drawing View, for example:

UPDATE:
I believe only those DrawingCurves with Not .Evaluator3D Is Nothing should be processed.

Please add me to your copyright note 😄