| |
Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych |
 |
Makra - Rozkładanie krzywej na proste linie
advertik - 1 Luty 2015, 11:23
Temat postu: Rozkładanie krzywej na proste linie
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 - 1 Luty 2015, 18:31
| advertik napisał/a: | | Termin realizacji: maksymalnie 14 dni. |
I ma być tani i konkurencyjny dla 3D System BPI? hehe....
Chętnie to zobaczę.
advertik - 1 Luty 2015, 20:10
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 - 1 Luty 2015, 20:52
| advertik napisał/a: | | w poprzednim poście było trochę zgryźliwości |
{CENZURA}. W każdym razie termin 14 dni jest optymistyczny. Nie mogę zająć się makrem z uwagi na brak czasu i na zbieżność obu projektów. Ciekawi mnie tylko jak z pewnymi problemami o których ja już wiem poradzi sobie konkurencja. To nie jest takie proste na jakie wygląda.
advertik - 1 Luty 2015, 23:22
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 - 13 Maj 2015, 09:17
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
|
|
|