ADN Club > VBA
Добавление к MLeader еще одной выноски
Vladimir:
Спасибо, то что нужно.
Еще один каверзный вопрос по выноске.
В существующую выноску добавляю еще одну выноску
--- Код - Visual Basic [Выбрать] --- '// Добавляем вторую выноску в нулевой кластер Call Leader.AddLeaderLine(0, V) ' V координаты второй выноски Все создается, но при перетаскивании выноски в другое место, средствами AutoCad, переносится только основная выноска, а у второй выноски появляется дополнительная точка см скриншот.
Можно исправить этот момент?
Александр Ривилис:
Давай полностью код.
Vladimir:
--- Код - Visual Basic [Выбрать] ---Sub Centre_MLeaderLine()Dim firstPoint As VariantDim secondPoint As VariantDim freePoint As VariantDim str_MLeaderLine As StringDim Leader As VariantDim N As Long '(назначение не понятно) firstPoint = ThisDrawing.Utility.GetPoint(, "Укажите центр окружности: ") secondPoint = ThisDrawing.Utility.GetPoint(firstPoint, "Укажите расположение выноски: ") '// Массив координат (2 точки MLeader, следовательно 6 элементов в массиве) Dim V(0 To 5) As Double V(0) = firstPoint(0) V(1) = firstPoint(1) V(2) = firstPoint(2) V(3) = secondPoint(0) V(4) = secondPoint(1) V(5) = secondPoint(2) str_MLeaderLine = Replace("I= " & Round(firstPoint(0) - XZero, 4) & " / J= " & Round(firstPoint(1), 4) - YZero, ",", ".") '// Добавляем MLeader. Если мы хотим добавить MLeader с текстом, то текущим '// стилем должен быть стиль у которого контент настроен на MText Set Leader = ThisDrawing.ModelSpace.AddMLeader(V, N) '// Настраиваем свойства Leader.TextString = str_MLeaderLine '// собственно текст (может быть многострочным) Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка Leader.ArrowheadSize = 2 '// длина стрелки 'Leader.DogLegged = False '// без горизонтальной полки 'Leader.DoglegLength = 0 '// длина полки = 0 Leader.LandingGap = 2 '// отступ текста от полки по-горизонтали '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой ' Leader.TextLeftAttachmentType = acAttachmentMiddle ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter Leader.TextFrameDisplay = False '// текст без рамки Leader.TextBackgroundFill = False '// текст без заливки фона Leader.TextDirection = acLeftToRight '// текст слева-направо Leader.TextHeight = 3.5 '// высота текста Leader.TextWidth = 0 '// ширина текста (используется для переноса текста по словам) Leader.TextJustify = acAttachmentPointBottomCenter '// выравнивание текста freePoint = ThisDrawing.Utility.GetPoint(secondPoint, "Укажите конец окружности: ") '// Массив координат для второй выноски V(0) = freePoint(0) V(1) = freePoint(1) V(2) = freePoint(2) '// Добавляем вторую выноску в нулевой кластер Call Leader.AddLeaderLine(0, V) 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, ",", ".") '// Настраиваем свойства Leader.TextString = str_MLeaderLine '// собственно текст (может быть многострочным) Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка Leader.ArrowheadSize = 2 '// длина стрелки 'Leader.DogLegged = False '// без горизонтальной полки 'Leader.DoglegLength = 0 '// длина полки = 0 Leader.LandingGap = 2 '// отступ текста от полки по-горизонтали '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой ' Leader.TextLeftAttachmentType = acAttachmentMiddle ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter Leader.TextFrameDisplay = False '// текст без рамки Leader.TextBackgroundFill = False '// текст без заливки фона Leader.TextDirection = acLeftToRight '// текст слева-направо Leader.TextHeight = 3.5 '// высота текста Leader.TextWidth = 0 '// ширина текста (используется для переноса текста по словам) Leader.TextJustify = acAttachmentPointBottomLeft '// выравнивание текста
Александр Ривилис:
Подозреваю, что не следует добавлять в нулевой кластер. Т.е. вместо:
--- Код - Visual Basic [Выбрать] ---'// Добавляем вторую выноску в нулевой кластерCall Leader.AddLeaderLine(0, V)Нужно записать:
--- Код - Visual Basic [Выбрать] ---Dim r As Longr = Leader.AddLeader() '// Добавляем вторую выноску в новый кластерCall Leader.AddLeaderLine(r, V)
Vladimir:
--- Цитата: Александр Ривилис от 17-05-2015, 18:37:10 ---Нужно записать:
--- Код - Visual Basic [Выбрать] ---Dim r As Longr = Leader.AddLeader() '// Добавляем вторую выноску в новый кластерCall Leader.AddLeaderLine(r, V)
--- Конец цитаты ---
Судя по статье Вершинина И.В. http://cadhouse.narod.ru/articles/acad/acad_mleaders.htm кластеров может быть только два.
Кластер с лева от текста (0) и с права от текста (1)
Тем не менее, предложенный вариан замечательно работает с текстом расположенным с права от выноски.
Если, текст расположен с лева от выноски, то основная выноска располагается правильно, а дополнительная выноска выходит из нулевого кластера.
После незначительного перемещения выноски, средствами AutoCad, дополнительная выноска встает на свое законное место.
Приведенная закономерность не зависит от того, в каком месте процедуры расположен код управляющий расположением текста относительно выноски: после создания основной выноски, после создания дополнительной выноски или после основной и дополнительной выносок.
--- Код - Visual Basic [Выбрать] ---Sub interpolation_CW() 'круговая интерполяция по часовой стрелкеDim firstPoint As VariantDim secondPoint As VariantDim freePoint As VariantDim str_MLeaderLine As StringDim Leader As VariantDim N As Long '(назначение не понятно)Dim vector(2) As Double ' расположение текста относительно выноски 'N = MLeaderDictionary.Count firstPoint = ThisDrawing.Utility.GetPoint(, "Укажите центр окружности: ") secondPoint = ThisDrawing.Utility.GetPoint(firstPoint, "Укажите расположение выноски: ") '// Массив координат (2 точки MLeader, следовательно 6 элементов в массиве) Dim V(0 To 5) As Double V(0) = firstPoint(0) V(1) = firstPoint(1) V(2) = firstPoint(2) V(3) = secondPoint(0) V(4) = secondPoint(1) V(5) = secondPoint(2) str_MLeaderLine = Replace("I= " & Round(firstPoint(0) - XZero, 4) & " / J= " & Round(firstPoint(1), 4) - YZero, ",", ".") '// Добавляем MLeader. Если мы хотим добавить MLeader с текстом, то текущим '// стилем должен быть стиль у которого контент настроен на MText Set Leader = ThisDrawing.ModelSpace.AddMLeader(V, N) '// Настраиваем свойства Leader.TextString = str_MLeaderLine '// собственно текст (может быть многострочным) Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка Leader.ArrowheadSize = 2 '// длина стрелки 'Leader.DogLegged = False '// без горизонтальной полки 'Leader.DoglegLength = 0 '// длина полки = 0 Leader.LandingGap = 2 '// отступ текста от полки по-горизонтали '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой ' Leader.TextLeftAttachmentType = acAttachmentMiddle ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter Leader.TextFrameDisplay = False '// текст без рамки Leader.TextBackgroundFill = False '// текст без заливки фона Leader.TextDirection = acLeftToRight '// текст слева-направо Leader.TextHeight = 3.5 '// высота текста Leader.TextWidth = 0 '// ширина текста (используется для переноса текста по словам) Leader.TextJustify = acAttachmentPointBottomCenter '// выравнивание текста ' Управляем тем, с какой стороны будет расположен текст выноски If firstPoint(0) > secondPoint(0) Then vector(0) = -1 Else vector(0) = 1 End If Leader.SetDoglegDirection 0, vector freePoint = ThisDrawing.Utility.GetPoint(secondPoint, "Укажите конец окружности: ") '// Массив координат для второй выноски V(0) = freePoint(0) V(1) = freePoint(1) V(2) = freePoint(2) '// Добавляем вторую выноску в нулевой кластер 'Call Leader.AddLeaderLine(0, V) Dim r As Long r = Leader.AddLeader() '// Добавляем вторую выноску в новый кластер Call Leader.AddLeaderLine(r, V) 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, ",", ".") '// Настраиваем свойства Leader.TextString = str_MLeaderLine '// собственно текст (может быть многострочным) Leader.ArrowheadType = acArrowDefault '// обычная залитая стрелка Leader.ArrowheadSize = 2 '// длина стрелки 'Leader.DogLegged = False '// без горизонтальной полки 'Leader.DoglegLength = 0 '// длина полки = 0 Leader.LandingGap = 2 '// отступ текста от полки по-горизонтали '// Подчеркиваем 1-ю строку текста - получается как бы текст над полкой ' Leader.TextLeftAttachmentType = acAttachmentMiddle ' Leader.TextRightAttachmentType = acAttachmentPointMiddleCenter Leader.TextFrameDisplay = False '// текст без рамки Leader.TextBackgroundFill = False '// текст без заливки фона Leader.TextDirection = acLeftToRight '// текст слева-направо Leader.TextHeight = 3.5 '// высота текста Leader.TextWidth = 0 '// ширина текста (используется для переноса текста по словам) Leader.TextJustify = acAttachmentPointBottomLeft '// выравнивание текста ' Управляем тем, с какой стороны будет расположен текст выноски If firstPoint(0) > secondPoint(0) Then vector(0) = -1 Else vector(0) = 1 End If Leader.SetDoglegDirection 0, vector end sub
Навигация
Перейти к полной версии