fine

  • 21.02.13, 00:30
<iframe src="http://www.facebook.com/video/embed?video_id=133253163504265" width="640" height="480" frameborder="0"></iframe>

макрос корел

  • 24.11.12, 10:37
Sub GetLength()

Dim cObjCDRID As Long
Dim s As Long
Dim N As Long

With CorelDRAW.CorelScript

cObjCDRID = .GetObjectsCDRStaticID()

s = ActiveDocument.WorldScale * .GetCurveLength / 10000
N = .CreateArtisticText("L = " & Format(s, "###0.00") & " sys mm", 0, 0)

End With
End Sub

Sub GetSq()
Dim cID As Long
Dim cID_50 As Long
Dim cID_T As Long
Dim L As Double
Dim Y As Long
Dim dY As Long
Dim X As Long
Dim pY As Long
Dim pX As Long
Dim Err As Long
Dim NodesC As Long
Dim i As Long
Dim s As Long
Dim l_Err As Long

With CorelDRAW.CorelScript
cID_T = .GetObjectsCDRStaticID()
Err = .GetSize(X, Y)
Err = .GetPosition(pX, pY)
' CreateRectangle(Top As Long, Left As Long, Bottom As Long, Right As Long, CornerRadius As Long, CornerRadius2 As Long, CornerRadius3 As Long, CornerRadius4 As Long) As Long
Err = .CreateRectangle(10000, 2000, 3000, 50000, 0, 0, 0, 0)
dY = Y / 100
Err = .SetSize(X + 2000, dY)
Err = .SetPosition(pX - 1000, pY - dY / 2)
Err = .ConvertToCurves()
NodesC = .GetCurveNodeCount()
ActiveShape.Curve.Nodes.All.BreakApart

cID = .GetObjectsCDRStaticID()

For i = 1 To 49
Err = .DuplicateObject(0, -2 * dY)
Next i

cID_50 = .GetObjectsCDRStaticID()

For i = 1 To 48
l_Err = .AppendObjectToSelection(cID_50 - i)
Next i
l_Err = .AppendObjectToSelection(cID)

l_Err = .Combine
cID = .GetObjectsCDRStaticID()
l_Err = .AppendObjectToSelection(cID_T)
l_Err = .Intersection(-1, 0)

'If ActiveDocument.SelectionInfo.IsGroupSelected Then
'l_Err = .Ungroup
'l_Err = .Combine
'End If

L = ActiveDocument.WorldScale * .GetCurveLength / 10000
l_Err = .DeleteObject

s = ActiveDocument.WorldScale * L * (dY / 10000)
End With
l_Err = MsgBox(Format(s, "### ### ### ### ##0.00") & "  mm2", vbOKOnly, "ieiueia")
End Sub


Sub getSQ_100()

Dim cID, s, vbRES, l_Err, i As Long
Dim cID_1 As Long
Dim i100 As Long
Dim SM(20) As Long

Dim cID_50 As Long
Dim cID_T As Long
Dim L As Double
Dim Y As Long
Dim dY As Long
Dim X As Long
Dim pY As Long
Dim pX As Long
Dim Err As Long
Dim NodesC As Long

s = 0
cID_1 = CorelDRAW.CorelScript.GetObjectsCDRStaticID()

For i100 = 1 To 20
With CorelDRAW.CorelScript
cID_T = .GetObjectsCDRStaticID()
Err = .GetSize(X, Y)
Err = .GetPosition(pX, pY)
' CreateRectangle(Top As Long, Left As Long, Bottom As Long, Right As Long, CornerRadius As Long, CornerRadius2 As Long, CornerRadius3 As Long, CornerRadius4 As Long) As Long
Err = .CreateRectangle(10000, 2000, 3000, 50000, 0, 0, 0, 0)
dY = Y / 100
Err = .SetSize(X + 2000, dY)
Err = .SetPosition(pX - 1000, pY - dY / 2)
Err = .ConvertToCurves()
NodesC = .GetCurveNodeCount()
ActiveShape.Curve.Nodes.All.BreakApart

cID = .GetObjectsCDRStaticID()

For i = 1 To 49
Err = .DuplicateObject(0, -2 * dY)
Next i

cID_50 = .GetObjectsCDRStaticID()

For i = 1 To 48
l_Err = .AppendObjectToSelection(cID_50 - i)
Next i
l_Err = .AppendObjectToSelection(cID)

l_Err = .Combine
cID = .GetObjectsCDRStaticID()
l_Err = .AppendObjectToSelection(cID_T)
l_Err = .Intersection(-1, 0)

'If ActiveDocument.SelectionInfo.IsGroupSelected = True Then
'l_Err = .Ungroup
'l_Err = .Combine
'End If

L = ActiveDocument.WorldScale * .GetCurveLength / 10000
l_Err = .DeleteObject

SM(i100) = ActiveDocument.WorldScale * L * (dY / 10000)
End With

If s < SM(i100) Then
s = SM(i100)
End If

l_Err = CorelDRAW.CorelScript.SelectObjectOfCDRStaticID(cID_1)
ActiveDocument.Selection.Rotate (1)

Next i100

ActiveDocument.Selection.Rotate (-20)

s = s
vbRES = MsgBox(Format(s, "### ### ### ### ##0.00") & "  mm2", vbOKOnly, "ieiueia")
End Sub


Шкатулки, коробочки и другая упаковка из дерева (044 2371483)



Дизайн
и производство любых форм и коннструкций : упаковка из дерева.

Связь: [email protected] или (044-063) 2371483, (044-063) 2470501, (044) 4516041

смотрите также :  * фотобанк работ  * гробы для домашних животных


Наши друзья : Бюро ритуальных услуг для животных :

Украина, г. Киев (044) 2337314 (044) 2337366  (066) 7214057

[email protected]