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

FAQFAQ  SzukajSzukaj  UżytkownicyUżytkownicy  GrupyGrupy
RejestracjaRejestracja  ZalogujZaloguj  DownloadDownload

Poprzedni temat «» Następny temat
Szybkie wymiarowanie - korekta makra
Autor Wiadomość
zyzio 
Praktyk


Dołączył: 06 Cze 2011
Posty: 90
Skąd: Podkarpacie
Wysłany: 24 Sierpień 2021, 09:41   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.
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Nowe zasady dotyczące cookies. Wykorzystujemy pliki cookies, aby nasz serwis lepiej spełniał Państwa oczekiwania. Można zablokować zapisywanie cookies, zmieniając ustawienia przeglądarki.
         
Strona wygenerowana w 0.07 sekundy. Zapytań do SQL: 13