Distance measure script

drawincorel
over 1 year ago

Hi!

Could I have some guidance for creating a macro, that allows me to select objects such as in the above picture and measure

and show the distance between the middle point of the first object (different shape than the rest) and the middle point of rest of the objects.

I mean, if I select all of the above objects and click the macro, it then measures and shows the distance between all the circles and the line.

Parents
  • over 1 year ago

    Hello, drawincorel

    I have 2 variants of code:

    The first of them is started pressing the command button of any form or from hotkey assigned to macro and return distance from blue object in mm.

    Private Sub CommandButton4_Click()
    Dim BhBp_Shape, text1 As Shape
    ActivePage.Layers("DISTANCE_LAYER").Shapes.All.Delete

    Start_CenterX = ActivePage.Shapes("Start").CenterX
    For Each BhBp_Shape In ActivePage.Shapes
    If BhBp_Shape.Name = "Start" Then
    Else
    'Set MLINE8 = ActiveLayer.CreateLineSegment(Mleftx, Mtopy, Mleftx - tbLength.Text, Mtopy)
    'Set text1 = BhBp_Shape.Layer.CreateArtisticText(BhBp_Shape.CenterX, BhBp_Shape.CenterY, "OK")
    Set text1 = ActivePage.Layers("DISTANCE_LAYER").CreateArtisticText(BhBp_Shape.CenterX, BhBp_Shape.CenterY, (BhBp_Shape.CenterX - Start_CenterX) * 25.4)

    'text1.CenterX = BhBp_Shape.CenterX
    'text1.CenterY = BhBp_Shape.CenterY

    End If

    Next
    End Sub

    Pressing command button prints distance of every shape except blue bar near the centre. Blue bar must have name Start


    The second variant is attractive. When any of the shape is moved, distance value is refreshed with new actual value.

     Code is at ThisDocument level

    Private Sub Document_ShapeMove(ByVal Shape As Shape)

    Dim BhBp_Shape, text1 As Shape
    ActivePage.Layers("DISTANCE_LAYER").Shapes.All.Delete

    Start_CenterX = ActivePage.Shapes("Start").CenterX
    For Each BhBp_Shape In ActivePage.Shapes
    If BhBp_Shape.Name = "Start" Then
    'Null
    Else
    Set text1 = ActivePage.Layers("DISTANCE_LAYER").CreateArtisticText(BhBp_Shape.CenterX, BhBp_Shape.CenterY, (BhBp_Shape.CenterX - Start_CenterX) * 25.4)
    End If
    Next
    End Sub


    Greetings!

Reply Children

© Corel Corporation. All rights reserved. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms of Use / Privacy​ ​/ ​Cookies / Terms and Conditions / User Guidelines.