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

Makra - PROCENT KRYCIA

ajacques - 31 Styczeń 2014, 14:39
Temat postu: PROCENT KRYCIA
Stopień krycia dowolnej strony krzywymi
- zaznacz dowolną liczbę obiektów
(obiekty mają być krzywymi oraz nie może być zaznaczona grupa)

Kod:

Sub krycie_obiektkartki()
    ActiveDocument.Unit = cdrMillimeter
    Dim s As Shape
    Dim wypelnienie As Double
    Dim x As Double, y As Double
    Dim iloscobiektow As Integer
    Dim sr As ShapeRange
    Dim polepowierzchni As Double, polepowierzchnigrupa As Double, polepowierzchnicalosc As Double
    polepowierzchni = 0
    polepowierzchnigrupa = 0
    polepowierzchnicalosc = 0
    iloscobiektow = 0
    wypelnienie = 0
    ActiveDocument.ActivePage.GetSize x, y
    polepowierzchnicalosc = (x * y) / 100
    Set sr = ActiveSelectionRange
    For Each s In sr
        iloscobiektow = iloscobiektow + 1
        s.ConvertToCurves
        polepowierzchni = s.Curve.Area
        polepowierzchnigrupa = polepowierzchni + polepowierzchnigrupa
    Next s
    wypelnienie = ((100 * polepowierzchnigrupa) / polepowierzchnicalosc) / 100
    MsgBox "CAŁKOWICE POLE: " & polepowierzchnicalosc & " cm2" & Chr(13) & "WYPEŁNIENIE: " & polepowierzchnigrupa / 100 & " cm2" & "    Ilość obiektów: " & iloscobiektow & Chr(13) & Chr(13) & "WYPEŁNIENIE  " & wypelnienie & " %"
End Sub



Stopień krycia wg pola zaznaczonych obiektów.
- zaznacz dowolną liczbę obiektów
(obiekty mają być krzywymi oraz nie może być zaznaczona grupa)
Kod:

Sub krycie_obiekt()
    ActiveDocument.Unit = cdrMillimeter
    Dim s As Shape
    Dim wypelnienie As Double
    Dim x As Double, y As Double
    Dim iloscobiektow As Integer
    Dim sr As ShapeRange
    Dim polepowierzchni As Double, polepowierzchnigrupa As Double, polepowierzchnicalosc As Double
   
    polepowierzchni = 0
    polepowierzchnigrupa = 0
    polepowierzchnicalosc = 0
    iloscobiektow = 0
    wypelnienie = 0
   
    ActiveSelection.GetSize x, y
    polepowierzchnicalosc = (x * y) / 100
   
   
   
   
    Set sr = ActiveSelectionRange
    For Each s In sr
        iloscobiektow = iloscobiektow + 1
        s.ConvertToCurves
        polepowierzchni = s.Curve.Area
        polepowierzchnigrupa = polepowierzchni + polepowierzchnigrupa
    Next s
   
    wypelnienie = ((100 * polepowierzchnigrupa) / polepowierzchnicalosc) / 100
   
    MsgBox "CAŁKOWICE POLE: " & polepowierzchnicalosc & " cm2" & Chr(13) & "WYPEŁNIENIE: " & polepowierzchnigrupa / 100 & " cm2" & "    Ilość obiektów: " & iloscobiektow & Chr(13) & Chr(13) & "WYPEŁNIENIE  " & wypelnienie & " %"
End Sub

Artur Miernik - 31 Styczeń 2014, 18:13

Panie i Panowie, powitajmy Andrzeja Żaka.

PS. mikomowa, żółta książeczka i forum — corel.oferuje.pl


Powered by phpBB modified by Przemo © 2003 phpBB Group