Zahvaljujem se na odgovoru, meni trebaju macroi otvorenog koda jer radim komplet dodataka tj macro naredbi za CorelDraw.
Pronasao sam racunanje duzine linije i povrsine zatvorenog objekta, koji su na vecini macro paketa komercijalni.
Podijelit cu sa vama naravno:
Code:
Public Sub PovrsinaObjekta()
ActiveDocument.unit = cdrMillimeter
If ActiveDocument.Selection.Shapes.Count = 0 Then
MsgBox ("Prvo odaberite objekat!"), vbInformation
Else
If ActiveDocument.Selection.Shapes(1).Type <> cdrCurveShape Then
MsgBox ("Objekat mora da bude od linija."), vbInformation
Else
MsgBox ("Površina odabranog objekta je: " & Round(ActiveDocument.Selection.Shapes(1).Curve.Area, 2) & " mm2")
End If
End If
End Sub
Code:
Public Sub DuzinaLinije()
If ActiveDocument.Selection.Shapes.Count = 0 Then
MsgBox ("Prvo odaberite objekat ili liniju!")
Exit Sub
Else
If ActiveDocument.Selection.Shapes(1).Type <> cdrCurveShape Then
MsgBox ("Objekat mora da bude od linija.")
Exit Sub
Else
MsgBox ("Dužina linije odabranog objekta je: " & ConvertUnits(ActiveDocument.Selection.Shapes(1).Curve.Length, ActiveDocument.unit, ActiveDocument.Rulers.HUnits) & GetUnitName(ActiveDocument.Rulers.HUnits))
End If
End If
End Sub
Private Function GetUnitName(unit As cdrUnit) As String
Select Case unit
Case cdrAgate: GetUnitName = "Agate"
Case cdrCentimeter: GetUnitName = "cm"
Case cdrCicero: GetUnitName = "Cicero"
Case cdrDidots: GetUnitName = "Didots"
Case cdrFoot: GetUnitName = "Foot"
Case cdrInch: GetUnitName = "Inch"
Case cdrKilometer: GetUnitName = "km"
Case cdrMeter: GetUnitName = "m"
Case cdrMile: GetUnitName = "Mile"
Case cdrMillimeter: GetUnitName = "mm"
Case cdrPica: GetUnitName = "Pica"
Case cdrPixel: GetUnitName = "Pixel"
Case cdrPoint: GetUnitName = "pt"
Case cdrTenthMicron: GetUnitName = "TenthMicron"
Case cdrUnitH: GetUnitName = "UnithH"
Case cdrUnitQ: GetUnitName = "UnitQ"
Case cdrYard: GetUnitName = "Yard"
End Select
End Function