Zobacz temat - Lista współrzędnych

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

Makra - Lista współrzędnych

rademenes - 26 Marzec 2012, 15:01
Temat postu: Lista współrzędnych

Witam!!

Potrzebuję pomocy w pewnym temacie.

Rysuję np. koło -> zamieniam linie ciągłą na punktową -> rozdzielam punkty na osobne obiekty.

Teraz gwóźdź programu. Jak z powiedzmy 400 szt. punktów zrobić listę współrzędnych każdego z nich (ujemnych i dodatnich).

dokładnie chodzi mi o to żeby wartości można było skopiować do excel'a w formie:

kolumna A: point;0,000 (gdzie 0,000 = wartość y)
kolumna B: 0,000 (gdzie 0,000 = wartość x)
kolumna C: same zera (no problem)

jeden wiersz = jeden obiekt (punkt)

ponadto żeby punkty były podawane w kolejności jeden po drugim

Za wszelką pomoc z góry dziękuję.

chezare - 29 Marzec 2012, 01:07

W najprymitywniejszej postaci to taki kod mógłby wyglądać tak:

Sub Wspolrzedne()
Dim s As Shape
Dim x As Double
Dim y As Double
Dim wsp As String
wsp = ""
For Each s In ActiveDocument.Pages(1).FindShapes(cdrShape)
s.CreateSelection
s.GetPosition x, y
wsp = wsp + Str(x * 25.3995) + Chr(9) + Str(y * 25.3995) + Chr(13)
Next s
ActiveDocument.Pages(1).ActiveLayer.CreateParagraphText 0, 0, 3, 11.693, wsp, Font:="Arial", Size:=4
End Sub

Niestety w takiej postaci wyszukiwane są tylko obiekty na pierwszej stronie i wszystkie jakie się na niej znajdują. Jeśli jest tylko to co ma być zapamiętane to w porządku ale jak tych wynalazków jest więcej, to nic z tego nie wyjdzie bo zapiszą się współrzędne wszystkich obiektów.
Oczywiście można by zawęzić wyszukiwanie np. tylko do zaznaczenia, albo jakiegoś konkretnego koloru. Niewygodny jest też sposób prezentacji wyników, procedura tworzy ramkę tekstu akapitowego i w nią wpisuje współrzędne. Jak jest tych wyników dużo, to nie wszystkie będzie widać, żeby je za jednym zamachem skopiować trzeba będzie rozciągnąć ramkę albo z menu kontekstowego wybrać dopasuj tekst do ramki, co spowoduje takie zmniejszenie rozmiaru fontu żeby tekst się w ramce mieścił. Później to już tylko F8, ctrl+home, ctrl+shift+end i ctrl+C. Do Excela i Ctrl+V :-)

To też można by usprawnić kopiując np. wyniki do schowka, ale ponieważ ja w VBA głupi jestem, to póki co wiem, że da się to zrobić, ale jak jeszcze nie wiem i dlatego użyłem takiej metody.

rademenes - 29 Marzec 2012, 14:16

Dziękuję Chezare :-)

Działa wszystko jak należy ;-)

maroQ - 5 Kwiecień 2012, 15:17

chezare napisał/a:

W najprymitywniejszej postaci

Kod:

Sub Wspolrzedne()
Dim s As Shape
Dim wsp As String
wsp = "A" & vbTab & "B" & vbTab & "C" & vbNewLine
ActiveDocument.Unit = cdrMillimeter
For Each s In ActivePage.FindShapes(, cdrShape)
wsp = wsp & "point;" & Replace(Math.Round(s.PositionX, 3), ".", ",") & vbTab & Replace(Math.Round(s.PositionY, 3), ".", ",") & vbTab & "0" & vbNewLine
Next s
ActiveLayer.CreateParagraphText 0, 0, 30, 116.93, wsp, , , "Arial", 4
End Sub

Może to się komuś przyda: piszemy wewnątrz sub

Kod:

VBA.

i pojawia się lista stałych. Później wystarczy tylko wyłuskać dane dziecko VBA i używać.

Program poprawiłem by był bardziej "po Bożemu" (pewne skróty myślowe przechodzą w VBA ale w innych językach już nie więc "akademicko" tak jest lepiej). Poza tym wszystko OK.

Odnośnie zamiany "+" na "&", to to jest zbędne, ale "&" zawsze można użyć, a plusa nie zawsze.

do wszystkich: Wesołych Świąt Wielkanocnych! + Wesołego jajka :-P

chezare - 5 Kwiecień 2012, 18:58

Jak do wszystkich to i do mnie :-)

Dziękuję za życzenia i oczywiście również życzę Ci radosnych Świąt Wielkiejnocy.
Przy okazji, jak MaroQ wkleić w VBA tekst do windowsowego schowka? :-)

maroQ - 5 Kwiecień 2012, 19:10

chezare napisał/a:

Jak do wszystkich to i do mnie

No tak

w końcu do wszystkich.

chezare napisał/a:

wkleić tekst do windowsowego schowka

Właściwie to nigdy tego nie robiłem z VBA, ale jak się okazuje to bardzo proste:

Kod:

Sub Wspolrzedne()
Dim s As Shape
Dim dob As New DataObject
Dim wsp As String
wsp = "A" & vbTab & "B" & vbTab & "C" & vbNewLine
ActiveDocument.Unit = cdrMillimeter
For Each s In ActivePage.FindShapes(, cdrShape)
wsp = wsp & "point;" & Replace(Math.Round(s.PositionX, 3), ".", ",") & vbTab & Replace(Math.Round(s.PositionY, 3), ".", ",") & vbTab & "0" & vbNewLine
Next s
dob.SetText wsp
dob.PutInClipboard
End Sub

chezare - 6 Kwiecień 2012, 08:52

Dziękuję Maro :-)