Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych

Makra - Szybkie wymiarowanie - korekta makra

zyzio - 24 Sierpień 2021, 10:41
Temat postu: Szybkie wymiarowanie - korekta makra
Witam. Posklejałem makro, które ma automatycznie zwymiarować zaznaczenie w osi x i y.
Na pierwszy rzut oka działa w miarę ok, lecz pojawia się jaki¶ dziwny problem, gdy zmieniam położenie tekstu na wymiarze osi x, a mianowicie tekst odseparowuje się a linie wymiarowania x i y staj± się jednym obiektem. Nie potrafię sobie poradzić z tym problemem, więc z góry dzięki za pomoc.

Kod:
Sub QuickDimensions()
    ActiveDocument.unit = cdrMillimeter
    Dim srSelection As ShapeRange
    Dim x As Double, y As Double, w As Double, h As Double
    Dim sPt1 As SnapPoint, sPt2 As SnapPoint
    Dim s As Shape
   
   
    If ActiveSelectionRange.Count = 0 Then
        MsgBox "Zaznacz obiekty do zwymiarowania"
        Exit Sub
    Else
   
    ActiveDocument.BeginCommandGroup "Quick dimensions"

   
        Set srSelection = ActiveSelectionRange
        srSelection.GetBoundingBox x, y, w, h
       
        Set sPt1 = CreateSnapPoint(x, y + h + (0.1 * h))
        Set sPt2 = CreateSnapPoint(x + w, y + h + (0.1 * h))
        Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, sPt1, sPt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitMM)
        s.Dimension.TextShape.SetPosition sx + w / 2, y + h + (0.2 * h)
        s.Dimension.TextShape.Text.Story.Size = w * 0.1
       
       
        Set sPt1 = CreateSnapPoint(x - (w * 0.1), y)
        Set sPt2 = CreateSnapPoint(x - (w * 0.1), y + h)
        Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, sPt1, sPt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitMM)
        s.Dimension.TextShape.SetPosition x - (w * 0.2), y + sx / 2
        s.Dimension.TextShape.Text.Story.Size = h * 0.1


    End If
       
        ActiveDocument.ClearSelection
        srSelection.AddToSelection
        ActiveWindow.Refresh
       
       
        ActiveDocument.EndCommandGroup
       
   

End Sub


Edit:
Widzę, że problem który opisałem występuje w X3, więc to pewnie nie jest wina samego makra, tak czy inaczej pozostawię w±tek bo może komu¶ się przyda, a może kto¶ sobie jeszcze ulepszy ten kod.


Powered by phpBB modified by Przemo © 2003 phpBB Group