Automating dimensioning via VBA

Hi folks,

I'm currently working on a VBA project to simplify dimensioning for some of the work that I do.

Right now it seems a little too easy for me to pick an arbitrary point when I really want to get the shapes' extremities for the biggest overall dimension.

I've created some code that given the ShapeRange does a quick sort to find the highest top, lower bottom, furthest left, and furthest right shapes.

Then taking these shapes I create a list of snap-points and then use the proper points to generate my dimension.  I can't post the full code, so this is an example of what is going on (though copy-paste it may not work without tweaking):

Dim topShape As Shape

 Dim bottomShape As Shape

artRange.Sort "@shape1.top>@shape2.top"

Set topShape = artRange.Shapes(1)

artRange.Sort "@shape1.bottom<@shape2.bottom"
Set bottomShape = artRange.Shapes(1)

Dim snpt As SnapPoints

Set snpt = topShape.SnapPoints

If Not (target.DisplayCurve Is Nothing) Then
     For Each tNode In target.DisplayCurve.Nodes
          snpt.AddUserSnapPoint tNode.PositionX, tNode.PositionY
     Next
End If


This all works reasonably well, but the problem I run into is if a snap-point isn't at the very edge of a shape.  For example, I may have a curve that starts at 0, but the nodes that control it are at the 1" mark.

Is there a way to determine the point on a curve that is at the extreme edge of the shape?

Parents
No Data
Reply
  • Here is an idea!

    Sub VeryLeftDotXY()
    Dim s1 As Shape, s As Shape
    Dim cp As CrossPoint
    Dim cPs As CrossPoints
    Const delta As Double = 0.000001

    Set s1 = ActiveLayer.CreateEllipse2(3.95776, 8.355854, 2.626795, -1.790331)
    s1.ConvertToCurves
    s1.Rotate 35# 'now the node is not from the very edge

    Set s = ActiveLayer.CreateLineSegment(s1.LeftX + delta, s1.TopY, s1.LeftX + delta, s1.BottomY)

    Set cPs = s1.DisplayCurve.SubPaths(1).GetIntersections(s.DisplayCurve.SubPaths(1), cdrAbsoluteSegmentOffset)

    For Each cp In cPs
    Debug.Print cp.PositionX, cp.PositionY
    Next cp

    s.delete


    End Sub


    Here I receve coordinates for two CrossPoints 

    In case delta =0 ther is no  CrossPoint. thats why  delta >0

    Taras


Children