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, 10: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.
 

ABC CorelDRAW X7 PL

ABC CorelDRAW X7 PL
Roland Zimek

Cena: 39.90 z�

dodaj do koszyka
zobacz opis

 

CorelDRAW X7 PL. �wiczenia praktyczne

CorelDRAW X7 PL. �wiczenia praktyczne
Roland Zimek

Cena: 27.00 z�

dodaj do koszyka
zobacz opis

 

Corel PaintShop Pro X4. Obr�bka zdj�� cyfrowych. �wiczenia praktyczne

Corel PaintShop Pro X4. Obr�bka zdj�� cyfrowych. �wiczenia praktyczne
Roland Zimek

Cena: 34.90 z�

dodaj do koszyka
zobacz opis

 

�wiat poza jQuery. Biblioteki: AngularJS, KnockoutJS, BackboneJS eBook

Cena: 51.20 z�
Dodaj do koszyka

 

Roblox Lua w 24 godziny. Tworzenie gier dla początkujących

Roblox Lua w 24 godziny. Tworzenie gier dla początkujących
Roblox Corporation

Cena: 34.50 zł
zobacz opis

Strona wygenerowana w 0.09 sekundy. Zapytań do SQL: 13