как нарисовать дугу под уклоном?

[_MBK_]

Ответ: как нарисовать дугу под уклоном?

Так почему то предпоследний объект остается не объединенным

Проверить сейчас не на чем, а что если цикл в обратном порядке пустить или так сделать?

set  sI=ActiveLayer.Shapes(1)
For I = 1 To ActiveLayer.Shapes.count-1
Set sI = sI.Weld(ActiveLayer.Shapes(2), True, True)
Next I

 

[Auto]

Ответ: как нарисовать дугу под уклоном?

Так получается что ActiveLayer.Shapes(2) не в цикле, он статический и всегда второй((хотя...смотря как макрос видит это вообще). Тут еще вопрос по объектам остающимся после операции Weld. Так как мы их пока не трогаем(не удаляем) не получается так что макрос постоянно обновляет массив?

Тут в принципе не важно какой объект с каким будет объединяться, хоть первый с последним. В конце все они сольются в один. Нужно чтобы новый объект созданный из двух предыдущих, присоединял к себе следующий.

 

[ekali]

Ответ: как нарисовать дугу под уклоном?

Вы, во-первых, зря присваиваете переменными имена методов. Хоть бы iCount

какой-нибудь.Во-вторых, сколько у Вас фигур? Конечно, цикл работает быстрее без постоянного пересчета, но это имеет значение при больших объемах вычислений. У Вас можно как-то так:

Do until Activelayer.Shapes.Count=1
  iCount=ActiveLayer.Shapes.Count
 set s1= s1.Weld(ActiveLayer.Shapes(iCount),False, False)
Loop

И вопрос, а сколько узлов для кривой считается критично? У меня максимально - 147, это много?


​

 

[Auto]

Ответ: как нарисовать дугу под уклоном?

ругается на эту строку set s1= s1.Weld(ActiveLayer.Shapes(iCount),False, False)

Run-time error '424'

 

[_MBK_]

Ответ: как нарисовать дугу под уклоном?

Sub e()
Dim I As Long, count As Long
Set s1 = ActiveLayer.Shapes(1)
Do Until ActiveLayer.Shapes.count = 1
 iCount = ActiveLayer.Shapes.count
 Set s1 = s1.Weld(ActiveLayer.Shapes(iCount), False, False)
Loop
End Sub

И вопрос, а сколько узлов для кривой считается критично? У меня максимально - 147, это много?

Это нормально. Больше тысячи - уже напряг.

 

[Auto]

Ответ: как нарисовать дугу под уклоном?

Так работает!:y)

 

[ekali]

Ответ: как нарисовать дугу под уклоном?

Позже сообразила, что поторопилась. Вот так правильней:

Dim s1 As Shape
Dim i As Long, iE As Long
Dim x As Double
x = 20
For i = 1 To 5
    Set s1 = ActiveLayer.CreateRectangle(x * (i - 1), x, x * i, 0)
Next i


iE = ActiveLayer.Shapes.Count
Set s1 = ActiveLayer.Shapes(1)
For i = 2 To iE
    Set s1 = s1.Weld(ActiveLayer.Shapes(2), False, False)
Next i

Собственно, ни к чему массив по ходу цикла проверять. Там нужно циклом сливать первый объект со вторым, пока эти вторые не кончатся. Экономия времени, конечно, смешная, дело в принципе. И я думаю, все варианты тут, наверное, рабочие, просто надо было удалять оба объекта - и конечный, и исходный.

 

[Auto]

Ответ: как нарисовать дугу под уклоном?

Так тоже сливает все объекты, только в один большой прямоугольник:n)