Рисование автофигур в документах Word

[Sasha_Smirnov]

Так а я уже дал в руки спиннинг! А вы к нему прикрепили блесну-супер!

Сообщение от Sazary

А почему предупреждение выскакивает так рано (>33)? Или оно не для того, чтобы уберечь от зависания?

Ну понимаете — впервые «дали попробовать». Боялся — а вдруг всё рванёт?!..

Однако, если отключено «Автосохранение каждые 5 минут», то всё выполнятся гладко.

[Sasha_Smirnov]

За 2 года логику подзабыл — но красиво. Тем более если раскрасить.

Option Explicit

Sub CycloGraf()
' Макрос записан 23.05.2007 User (рисует эпи- и гипоциклоиды)'
    Const pi = 3.1415926535898
    Dim k As Integer: k = 4#  'количество приближающих дугу циклоиды сегментов
    If k < 1 Then Exit Sub
    Dim fi As Single          'полярная коодината (радиан)
    Dim ShiftX: ShiftX = 50 'сдвиг (точек) вправо от угла листа
    Dim ShiftY: ShiftY = 50 'сдвиг (точек) вниз от угла листа
    Dim A As Long               'радиус неподвижного круга
    Dim b As Long               'радиус подвижного круга (катящегося)
    Dim x() As Single, y() As Single 'Декартовы коорд. точек (точные)
    Dim Nn As Single, N As Single, nS As String, QUEST As Boolean
    Static Chislo_periodov As Variant
    
    If Chislo_periodov <= 0 Then Chislo_periodov = 2.25
    nS = InputBox("How many periods?", "1—42", Chislo_periodov)
    If IsNumeric(nS) = False Then GoTo NextChislo: Exit Sub
    N = CSng(nS)
    Chislo_periodov = N
    If N < 0.01 Then Chislo_periodov = 8: Exit Sub
    
    'If N <= 1 Then k = 28#
    'If N > 1 Then k = 25#
    'If N > 2 Then k = 12#
    'If N > 16 Then k = 6#
    'If N > 49 Then k = 4#
    'If N > 99 Then k = 3#  'здесь была калибровка, можно включить'
                                    
                        ReDim x(k * N * 40#) 'калибровка координат'
                        ReDim y(k * N * 20#)
    fi = 2 * pi / N / k
    A = 2000 * N
    b = 2000
    
HIPO:
    For Nn = 0 To k * N * 20# - 1#
    x(Nn) = (A + b) * Cos(Nn * fi) - b * Cos((A + b) / b * Nn * fi) + ShiftX
    y(Nn) = (A + b) * Sin(Nn * fi) - b * Sin((A + b) / b * Nn * fi) + ShiftY
    Next Nn
    
    
    With ActiveDocument.Shapes.BuildFreeform(msoEditingAuto, x(0), y(0))
        For Nn = 1 To k * N * 20# - 1#
        .AddNodes msoSegmentCurve, msoEditingAuto, x(Nn), y(Nn)
        Next Nn
        .AddNodes msoSegmentCurve, msoEditingAuto, x(0), y(0)
        .ConvertToShape.Select
    End With
    
    With Selection.ShapeRange
        .Height = 250
        .Width = 250
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
        .Left = CentimetersToPoints(0.5 - QUEST * 9)
        .Top = CentimetersToPoints(2)
    End With
    
    If Not QUEST And Chislo_periodov <> 2 Then
        b = -b:  QUEST = True
        If Chislo_periodov < 2 Then k = 3#
        GoTo HIPO
    End If
    
NextChislo:     Chislo_periodov = Chislo_periodov - 1#
End Sub

[Sazary]

Вот эта понравилась (нужно изменить b на 3450 и еще домножить fi на 7)

[Sasha_Smirnov]

Да, непредсказуемость очаровывает!.. Спасибо за работу иллюстратора!

[Sasha_Smirnov]

Для простоты запуска CycloGraf’а назначил ему (в документе TipaTory.doc) сочетание клавиш Alt-Shift-A. (A латинское.)

А вот один из ежей-солнц. Рисуется (по альт-Y) в документе MakeUrchins.doc.

[Sasha_Smirnov]

Такого не видел полгода: Word смотрят больше, чем Excel. IgorGo, ау-у!

[Sazary]

Еще немного поэкспериментировал с TipaTory.







b сделал 3450, а fi домножал на разные значения..

[Sasha_Smirnov]

А я почти всё лето-2005 только и экспериментировал! Но вот такого морского ежа ещё не видел. Очень рад, что хоть один человек (из 400 смотревших) «научился» и вник! А записывать значения... у меня целая «галерея», но это скучновато — кайф сам процесс!

[Sasha_Smirnov]

И вот, на 17 узлах, возник некий синусоидальный забор.

(Рисование — по альт-W, стирание — по альт-Q.)

[Sazary]

О какая штука