Corel FORUM

[advertik]

Witam,

zlecę wykonanie odpłatnie makra do Corel Draw X5 działającego w następujący sposób:

1. Makro dzieli obiekt wektorowy (w zdecydowanej większości przypadków będą to czcionki) na poszczególne odcinki krzywej.
2. Makro sprawdza długość każdej krzywej z dokładnością do 0,01mm.
3. Makro generuje pionowe linie w odstępach poziomych równych długości każdej krzywej z zaznaczonego obiektu.

W makrze musi być zawarta możliwość wskazywania początku, od którego generowany jest cały obiekt - w większości przypadków start będzie w górnym lewym rogu obiektu. Generowane linie makro musi oznaczać odpowiednimi kolorami, zmieniając także kolor krzywej na obiekcie źródłowym.

Jeśli znajdzie się ktoś, kto podejmie się napisania takiego makra i będzie się czuł na siłach - chętnie dodatkowo dopłacę za bardziej zaawansowaną funkcjonalność (automatyczne dodawanie offsetu do obiektu źródłowego, dodawanie linii co 2mm na łukach, itp.)

Termin realizacji: maksymalnie 14 dni.
Realizacja na podstawie umowy o dzieło lub faktura vat.

Zainteresowanym chętnie udostępnie plik poglądowy z "ręcznie" zrealizowanym zadaniem.

Kontakt: PW lub biuro@advertik.pl

Pozdrawiam
Hubert Krać

[maroQ]

[advertik]

Nie musi być konkurencyjny cenowo dla programu od 3D System.

Gdybym mógł go zaadoptować do swoich potrzeb, to zapewne nie pisałbym tutaj. Nie chodzi mi o rozpisywanie punktów, tylko o stworzenie linii załamań do frezowania boków liter przestrzennych z PCV.

Dziękuję jednak za zainteresowanie, choć wydaje mi się, że w poprzednim poście było trochę zgryźliwości - a niepotrzebnie.

Aha: i oczywiście, makro nie będzie udostępniane do dalszej odsprzedaży. Pracować ma tylko u nas w firmie.

[maroQ]

[advertik]

Podany przeze mnie termin 14 dni jest oczywiście terminem założonym przeze mnie, który niekoniecznie musi być akceptowalny przez ewentualnego wykonawcę. Podałem go raczej po to, by zobrazować zainteresowanym, że nie jestem zainteresowany odpowiedziami "mogę wykonać za pół roku".

BPI jest ciekawym programem, choć przygladałem się jemu tylko "z grubsza". To, co zwróciło moją uwagę to zbyt duża dokładność, która powinna być moim zdaniem zmniejszona do 1/2mm i skompensowana na całej długości, choć i tak taśma systemowa ma jakiś zakres tolerancji. My budujemy litery przyklejając bok z PCV do frontu i niestety, ale nie ma tu miejsca na błędy, bo wszystko musi być spasowane idealnie. W taśmie od 3D System małe niedokładności zostaną ukryte pod "zawijką" blachy aluminiowej.

Na razie ręcznie dzielę odcinki, sprawdzam ich długość i buduję sobie to, co mi potrzebne. Nie wydawało mi się to ciężkie do zrealizowania, bo ręczna robota ogranicza się tylko do kilku czynności, choć przy kilkunastu literach jest to już mozolna praca i łatwo o błąd.

Podsumowując, to termin jest luźny, a Tobie należą się wyrazy uznania za program BPI - nie przypuszczałem, że spotkam tu jego producenta.

[tomek123]

Też ciekawe zagadnienie, nie męcz rąk ;)

Kod:

Public lines As New Collection Public Sub Generuj_Linie() Dim i As Integer, j As Integer Dim x As Double, y As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double, vert_x As Double, vert_y As Double Dim w As Double, h As Double Dim s As Shape, linia As Shape Dim length As Double, start_point As Integer Dim dt As Variant, l As Variant Set lines = Nothing ActiveDocument.Unit = cdrMillimeter Set s = ActiveShape If ActiveSelection.SizeWidth = 0 Then MsgBox "Zaznacz obiekt" Exit Sub End If w = s.SizeWidth h = s.SizeHeight x = s.PositionX y = s.PositionY Optimization = True For i = 1 To s.Curve.Segments.count     s.Curve.Segments.Item(i).StartNode.GetPosition x1, y1     s.Curve.Segments.Item(i).EndNode.GetPosition x2, y2     length = s.Curve.Segments.Item(i).length     dt = Array(x1, y1, x2, y2, length)     lines.Add dt     create_point x1, y1, i Next i Optimization = False ActiveWindow.ActiveView.SetViewArea x - w / 3, y - h - h / 3, w * 5 / 3, h * 5 / 3 ActiveWindow.Refresh Do start_point = InputBox("Od którego wierzcholka zaczynasz?" & vbCr & "Od 1 do " & i - 1, "START POINT", 1) Loop While start_point > (i - 1) And start_point > 1 Optimization = True vert_x = x vert_y = y - h - 8 For j = 1 To lines.count + 1 l = lines.Item(start_point) Set linia = ActiveLayer.CreateCurveSegment(l(0), l(1), l(2), l(3)) linia.Outline.Color.RGBAssign 255, 0, 0 linia.OrderToBack linia.name = "linia" Set linia = ActiveLayer.CreateCurveSegment(vert_x, vert_y, vert_x, vert_y + 5) linia.Outline.Color.RGBAssign 0, 0, 255 linia.name = "linia" create_point vert_x, vert_y - 2, start_point input_lenght vert_x + l(4) / 2, vert_y + 3, l(4) start_point = start_point + 1 If start_point > lines.count Then start_point = 1 vert_x = vert_x + l(4) Next j Optimization = False ActiveWindow.Refresh    'MsgBox s End Sub Public Sub Clear() Optimization = True ActivePage.Shapes.FindShapes(Query:="@name = 'vertex'").Delete ActivePage.Shapes.FindShapes(Query:="@name = 'linia'").Delete ActivePage.Shapes.FindShapes(Query:="@name = 'lenght'").Delete Optimization = False ActiveWindow.Refresh End Sub Private Function create_point(x As Double, y As Double, nr As Integer) Dim point As Shape, txt As Shape, opis As Shape Set point = ActiveLayer.CreateEllipse(x - 1, y + 1, x + 1, y - 1) With point .Outline.Color.RGBAssign 0, 0, 0 .Outline.width = 0.05 .Fill.UniformColor.RGBAssign 255, 200, 200 End With Set txt = ActiveLayer.CreateArtisticText(x, y, nr, cdrPolish, cdrCharSetEastEurope, "Tahoma", 3, cdrFalse, cdrFalse, cdrNoFontLine, cdrCenterAlignment) With txt .CenterX = x .CenterY = y End With Set opis = ActivePage.SelectShapesFromRectangle(x - 2, y + 2, x + 2, y - 2, False).Group opis.ObjectData("Name").value = "vertex" End Function Private Function input_lenght(x As Double, y As Double, lenght) Dim txt As Shape Set txt = ActiveLayer.CreateArtisticText(x, y, lenght, cdrPolish, cdrCharSetEastEurope, "Tahoma", 2, cdrFalse, cdrFalse, cdrNoFontLine, cdrCenterAlignment) With txt .CenterX = x .CenterY = y .name = "lenght" End With End Function