Пересечение кривых

[vadsura]

Всем привет.
Поможите люди добрые.
Имеем 2 сплайна, как при помощи вба промаркировать (найти координаты) их точек пересечения.
Максимум 2.
Заранее благодарен.

Надо средствами кореловского вба.
Есть 2 кривые, выделяем 2 вместе, применяем команду исключить.
В нижней кривой добавятся новые узлы.Если применить команду Разъеденить Ctrl+K
к нижней кривой, то она распадется на 3 или 5 участков
в зависимости от к-ва точек пересечения (1 или 2)
По конечным точкам можно выудить координаты.
При помощи макроса получается, а как это оформить в виде подпрограммы ума не хватает.

 

[Fog_patch]

Ответ: Графические построения

GetIntersections

 

[vadsura]

Ответ: Графические построения

Спасибо за оперативность.
Работает.

 

[vadsura]

Ответ: Графические построения

осваиваю по хелпу, ногами не бейте.

Вот есть такое свойство у эллипса
Ellipse.CenterX
Property CenterX As Double

Хотел воспользоваться, не получилось.

Хочу построить 2 точки(эллипсы)
И соединить их центры отрезком.

Sub Macro3()
   
   Dim s1 As Shape
   Dim s2 As Shape
   Dim s3 As Shape
   
   Set s1 = ActiveLayer.CreateEllipse2(0#, 0#, 0.03, -0.03)
    s1.Fill.UniformColor.RGBAssign 255, 0, 0
    
   Set s2 = ActiveLayer.CreateEllipse2(4#, 0#, 0.03, 0.03)
    s2.Fill.UniformColor.RGBAssign 255, 0, 0
    
   'Set s3 = ActiveLayer.CreateCurveSegment(s1.Ellipse.CenterX, s1.Ellipse.CenterY, s2.Ellipse.CenterX, s2.Ellipse.CenterY)
 Set s3 = ActiveLayer.CreateCurveSegment(s1.CenterX, s1.CenterY, s2.CenterX, s2.CenterY)
End Sub

Подскажите как правильно сделать.

 

[vadsura]

Ответ: Графические построения

Вот так работает.
А почему в 1 варианте не работало?

Sub Macro3()
   
   Dim s1 As Shape
   Dim s2 As Shape
   Dim s3 As Shape
   Dim x(1, 2) As Double
   Dim y(1, 2) As Double
   
   
   Set s1 = ActiveLayer.CreateEllipse2(0#, 0#, 0.03, -0.03)
   s1.Fill.UniformColor.RGBAssign 255, 0, 0
   x1 = s1.Ellipse.CenterX
   y1 = s1.Ellipse.CenterY
 
   Set s2 = ActiveLayer.CreateEllipse2(4#, 0#, 0.03, 0.03)
   s2.Fill.UniformColor.RGBAssign 255, 0, 0
   x2 = s2.Ellipse.CenterX
   y2 = s2.Ellipse.CenterY
    
   'Set s3 = ActiveLayer.CreateCurveSegment(s1.Ellipse.CenterX, s1.Ellipse.CenterY, s2.Ellipse.CenterX, s2.Ellipse.CenterY)
  Set s3 = ActiveLayer.CreateLineSegment(x1, y1, x2, y2)
  
End Sub

 

[Sanchos]

Ответ: Графические построения

всё работает

 

[vadsura]

Ответ: Графические построения

Еще вопросик есть.
Вот например имеем курв сегмент2 отдельно взятый.
Как воспользоваться SubPath.GetPointPositionAt к данной кривой.


В хелповских примерах все в циклы зашито, не могу разобраться.

Sub Macro2()
   
  
   Dim sp As SubPath

   Dim t As Double, x As Double, y As Double


   
   Dim s1 As Shape
   Set s1 = ActiveLayer.CreateCurveSegment2(3.178642, 2.138701, 3.870484, -0.340402, 4.043445, -4.606764, 9.635839, -4.54911)
   
   ' Помогите
   '  GetPointPositionAt

   ActiveLayer.CreateEllipse2 x, y, 0.05
End Sub

 

[Sanchos]

Ответ: Графические построения

не совсем, я что то понял, но наверное имелось виду Parent

 

[vadsura]

Ответ: Графические построения

Имеем некую кривую.
Dim s1 As Shape
Set s1 = ActiveLayer.CreateCurveSegment2(3.178642, 2.138701, 3.870484, -0.340402, 4.043445, -4.606764, 9.635839, -4.54911)

Ее надо разбить (получить координаты)в пропорции 2 к 1
Лучше всего подходит GetPointPositionAt

На этом месте нарисовать маленький эллипс
ActiveLayer.CreateEllipse2 x, y, 0.05

Покажите на примере. Надо просто дописать код. GetPointPositionAt применяется к субпасам. Похоже я не могу врубиться в кореловскую модель объектов.

Спасибо за участие.

 

[Sanchos]

Ответ: Графические построения

А я не могу врубится что вам надо
к чему вам надо применить GetPointPositionAt ? Он применим только к Segment и SubPath.

 

[lev]

Ответ: Графические построения

В данном примере я ставлю эллипс на первый сегмент, для первого SubPath поменяйте s1.Curve.Segments на s1.Curve.SubPaths

Sub test()
  Dim s1 As Shape
  Set s1 = ActiveLayer.CreateCurveSegment2(3.178642, 2.138701, 3.870484, -0.340402, 4.043445, -4.606764, 9.635839, -4.54911)
  s1.Curve.Segments(1).GetPointPositionAt x#, y#, 2 / 3
  ActiveLayer.CreateEllipse2 x, y, 0.05
End Sub

зы и пользуйтесь тегами [ code]

 

[vadsura]

Ответ: Графические построения

зы и пользуйтесь тегами [ code]

Только хотел спросить кто это так красиво текст проги расставил?

Огромнейшее спасибо за помощь.