Добавление к MLeader еще одной выноски

[Vladimir]

Спасибо, то что нужно.
Еще один каверзный вопрос по выноске.
В существующую выноску добавляю еще одну выноску

Код - Visual Basic [Выбрать]

1.  '// Добавляем вторую выноску в нулевой кластер
2.  Call Leader.AddLeaderLine(0, V) ' V координаты второй выноски
3.  

Все создается, но при перетаскивании выноски в другое место, средствами AutoCad, переносится только основная выноска, а у второй выноски появляется дополнительная точка см скриншот.
Можно исправить этот момент?

[Александр Ривилис]

Давай полностью код.

[Vladimir]

Код - Visual Basic [Выбрать]

1. Sub Centre_MLeaderLine()
2. Dim firstPoint As Variant
3. Dim secondPoint As Variant
4. Dim freePoint As Variant
5. Dim str_MLeaderLine As String
6. Dim Leader As Variant
7. Dim N As Long '(назначение не понятно)
8.  
9.  firstPoint = ThisDrawing.Utility.GetPoint(, "Укажите центр окружности: ")
10.  secondPoint = ThisDrawing.Utility.GetPoint(firstPoint, "Укажите расположение выноски: ")
11.  
12.   '// Массив координат (2 точки MLeader, следовательно 6 элементов в массиве)
13.  Dim V(0 To 5) As Double
14.   V(0) = firstPoint(0)
15.   V(1) = firstPoint(1)
16.   V(2) = firstPoint(2)
17.   V(3) = secondPoint(0)
18.   V(4) = secondPoint(1)
19.   V(5) = secondPoint(2)
20.  
21.  
22.   str_MLeaderLine = Replace("I= " & Round(firstPoint(0) - XZero, 4) & " / J= " & Round(firstPoint(1), 4) - YZero, ",", ".")
23.   '// Добавляем MLeader. Если мы хотим добавить MLeader с текстом, то текущим
24.  '// стилем должен быть стиль у которого контент настроен на MText
25.  Set Leader = ThisDrawing.ModelSpace.AddMLeader(V, N)
26.  
27.  
28.  
29.   '// Настраиваем свойства
30.  Leader.TextString = str_MLeaderLine         '// собственно текст (может быть многострочным)
31.  Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка
32.  Leader.ArrowheadSize = 2             '// длина стрелки
33.  'Leader.DogLegged = False              '// без горизонтальной полки
34.  'Leader.DoglegLength = 0               '// длина полки = 0
35.  Leader.LandingGap = 2                 '// отступ текста от полки по-горизонтали
36.  '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой
37. ' Leader.TextLeftAttachmentType = acAttachmentMiddle
38. ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter
39.  
40.  
41.   Leader.TextFrameDisplay = False       '// текст без рамки
42.  Leader.TextBackgroundFill = False     '// текст без заливки фона
43.  Leader.TextDirection = acLeftToRight  '// текст слева-направо
44.  Leader.TextHeight = 3.5               '// высота текста
45.  Leader.TextWidth = 0                  '// ширина текста (используется для переноса текста по словам)
46.  Leader.TextJustify = acAttachmentPointBottomCenter '// выравнивание текста
47.  
48.  
49.  
50.  freePoint = ThisDrawing.Utility.GetPoint(secondPoint, "Укажите конец окружности: ")
51.  
52.   '// Массив координат для второй выноски
53.  V(0) = freePoint(0)
54.   V(1) = freePoint(1)
55.   V(2) = freePoint(2)
56.  
57.  
58.   '// Добавляем вторую выноску в нулевой кластер
59.  Call Leader.AddLeaderLine(0, V)
60.  
61.   str_MLeaderLine = Replace("I= " & Round(firstPoint(0) - XZero, 4) & " / J= " & Round(firstPoint(1), 4) - YZero & "\PX= " & Round(freePoint(0) - XZero, 4) & " / Y= " & Round(freePoint(1), 4) - YZero, ",", ".")
62.  
63.    '// Настраиваем свойства
64.  Leader.TextString = str_MLeaderLine         '// собственно текст (может быть многострочным)
65.  Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка
66.  Leader.ArrowheadSize = 2             '// длина стрелки
67.  'Leader.DogLegged = False              '// без горизонтальной полки
68.  'Leader.DoglegLength = 0               '// длина полки = 0
69.  Leader.LandingGap = 2                 '// отступ текста от полки по-горизонтали
70.  '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой
71. ' Leader.TextLeftAttachmentType = acAttachmentMiddle
72. ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter
73.  
74.  
75.   Leader.TextFrameDisplay = False       '// текст без рамки
76.  Leader.TextBackgroundFill = False     '// текст без заливки фона
77.  Leader.TextDirection = acLeftToRight  '// текст слева-направо
78.  Leader.TextHeight = 3.5               '// высота текста
79.  Leader.TextWidth = 0                  '// ширина текста (используется для переноса текста по словам)
80.  Leader.TextJustify = acAttachmentPointBottomLeft '// выравнивание текста
81.  
82.  

[Александр Ривилис]

Подозреваю, что не следует добавлять в нулевой кластер. Т.е. вместо:

Код - Visual Basic [Выбрать]

1. '// Добавляем вторую выноску в нулевой кластер
2. Call Leader.AddLeaderLine(0, V)

Нужно записать:

Код - Visual Basic [Выбрать]

1. Dim r As Long
2. r = Leader.AddLeader()  
3. '// Добавляем вторую выноску в новый кластер
4. Call Leader.AddLeaderLine(r, V)

[Vladimir]

Нужно записать:

Код - Visual Basic [Выбрать]

1. Dim r As Long
2. r = Leader.AddLeader()  
3. '// Добавляем вторую выноску в новый кластер
4. Call Leader.AddLeaderLine(r, V)

Судя по статье Вершинина И.В. http://cadhouse.narod.ru/articles/acad/acad_mleaders.htm кластеров может быть только два.
Кластер с лева от текста (0) и с права от текста (1)
Тем не менее, предложенный вариан замечательно работает с текстом расположенным с права от выноски.
Если, текст расположен с лева от выноски, то основная выноска располагается правильно, а дополнительная выноска выходит из нулевого кластера. 


После незначительного перемещения выноски, средствами AutoCad, дополнительная выноска встает на свое законное место.
Приведенная закономерность не зависит от того, в каком месте процедуры расположен код управляющий расположением текста относительно выноски: после создания основной выноски, после создания дополнительной выноски или после основной и дополнительной выносок.

Код - Visual Basic [Выбрать]

1. Sub interpolation_CW() 'круговая интерполяция по часовой стрелке
2. Dim firstPoint As Variant
3. Dim secondPoint As Variant
4. Dim freePoint As Variant
5. Dim str_MLeaderLine As String
6. Dim Leader As Variant
7. Dim N As Long '(назначение не понятно)
8. Dim vector(2) As Double ' расположение текста относительно выноски
9. 'N = MLeaderDictionary.Count
10.  
11.  firstPoint = ThisDrawing.Utility.GetPoint(, "Укажите центр окружности: ")
12.  secondPoint = ThisDrawing.Utility.GetPoint(firstPoint, "Укажите расположение выноски: ")
13.  
14.   '// Массив координат (2 точки MLeader, следовательно 6 элементов в массиве)
15.  Dim V(0 To 5) As Double
16.   V(0) = firstPoint(0)
17.   V(1) = firstPoint(1)
18.   V(2) = firstPoint(2)
19.   V(3) = secondPoint(0)
20.   V(4) = secondPoint(1)
21.   V(5) = secondPoint(2)
22.  
23.  
24.   str_MLeaderLine = Replace("I= " & Round(firstPoint(0) - XZero, 4) & " / J= " & Round(firstPoint(1), 4) - YZero, ",", ".")
25.   '// Добавляем MLeader. Если мы хотим добавить MLeader с текстом, то текущим
26.  '// стилем должен быть стиль у которого контент настроен на MText
27.  Set Leader = ThisDrawing.ModelSpace.AddMLeader(V, N)
28.  
29.  
30.  
31.   '// Настраиваем свойства
32.  Leader.TextString = str_MLeaderLine         '// собственно текст (может быть многострочным)
33.  Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка
34.  Leader.ArrowheadSize = 2             '// длина стрелки
35.  'Leader.DogLegged = False              '// без горизонтальной полки
36.  'Leader.DoglegLength = 0               '// длина полки = 0
37.  Leader.LandingGap = 2                 '// отступ текста от полки по-горизонтали
38.  '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой
39. ' Leader.TextLeftAttachmentType = acAttachmentMiddle
40. ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter
41.  
42.  
43.   Leader.TextFrameDisplay = False       '// текст без рамки
44.  Leader.TextBackgroundFill = False     '// текст без заливки фона
45.  Leader.TextDirection = acLeftToRight  '// текст слева-направо
46.  Leader.TextHeight = 3.5               '// высота текста
47.  Leader.TextWidth = 0                  '// ширина текста (используется для переноса текста по словам)
48.  Leader.TextJustify = acAttachmentPointBottomCenter '// выравнивание текста
49.  
50.       ' Управляем тем, с какой стороны будет расположен текст выноски
51. If firstPoint(0) > secondPoint(0) Then
52.  vector(0) = -1
53.  Else
54.  vector(0) = 1
55.  End If
56.    
57.  
58.     Leader.SetDoglegDirection 0, vector
59.  
60.  
61.  
62.  freePoint = ThisDrawing.Utility.GetPoint(secondPoint, "Укажите конец окружности: ")
63.  
64.   '// Массив координат для второй выноски
65.  V(0) = freePoint(0)
66.   V(1) = freePoint(1)
67.   V(2) = freePoint(2)
68.  
69.  
70.   '// Добавляем вторую выноску в нулевой кластер
71.  'Call Leader.AddLeaderLine(0, V)
72.  
73.  Dim r As Long
74.  
75. r = Leader.AddLeader()
76.  
77. '// Добавляем вторую выноску в новый кластер
78.  
79. Call Leader.AddLeaderLine(r, V)
80.  
81.  
82.  
83.   str_MLeaderLine = Replace("I= " & Round(firstPoint(0) - XZero, 4) & " / J= " & Round(firstPoint(1), 4) - YZero & "\PX= " & Round(freePoint(0) - XZero, 4) & " / Y= " & Round(freePoint(1), 4) - YZero, ",", ".")
84.  
85.    '// Настраиваем свойства
86.  Leader.TextString = str_MLeaderLine         '// собственно текст (может быть многострочным)
87.  Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка
88.  Leader.ArrowheadSize = 2             '// длина стрелки
89.  'Leader.DogLegged = False              '// без горизонтальной полки
90.  'Leader.DoglegLength = 0               '// длина полки = 0
91.  Leader.LandingGap = 2                 '// отступ текста от полки по-горизонтали
92.  '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой
93. ' Leader.TextLeftAttachmentType = acAttachmentMiddle
94. ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter
95.  
96.  
97.   Leader.TextFrameDisplay = False       '// текст без рамки
98.  Leader.TextBackgroundFill = False     '// текст без заливки фона
99.  Leader.TextDirection = acLeftToRight  '// текст слева-направо
100.  Leader.TextHeight = 3.5               '// высота текста
101.  Leader.TextWidth = 0                  '// ширина текста (используется для переноса текста по словам)
102.  Leader.TextJustify = acAttachmentPointBottomLeft '// выравнивание текста
103.  
104.  ' Управляем тем, с какой стороны будет расположен текст выноски
105. If firstPoint(0) > secondPoint(0) Then
106.  vector(0) = -1
107.  Else
108.  vector(0) = 1
109.  End If
110.    
111.  
112.     Leader.SetDoglegDirection 0, vector
113.  
114.  
115.  
116. end sub
117.  

[Александр Ривилис]

А если заменить:

Код - Visual Basic [Выбрать]

1. Leader.SetDoglegDirection 0, vector

на

Код - Visual Basic [Выбрать]

1. Leader.SetDoglegDirection r, vector

в строке 112 кода?

[Vladimir]

Огромное Вам спасибо!
Все работает.

[Александр Ривилис]

Огромное Вам спасибо!

Пожалуйста. 

Off-Topic: показать

На форуме в качестве спасибо есть еще кнопочки "+" и "-"