Форум пользователей Visio

Форум по вопросам применения и программирования в Visio
Текущее время: 29 мар 2024, 03:02

Часовой пояс: UTC + 3 часа [ Летнее время ]


Правила форума


При размещении файлов предпочтительным является формат vsd (а не vsdx/vsdm)
Размещая ваши вложения на форуме не используйте имена файлов содержащих кириллицу, в противном случае файл будет иметь имя .<расширение файла> !

Для форматирования ваших сообщений используйте BBCodes, описание используемых на форуме BBCodes.



Начать новую тему Ответить на тему  [ Сообщений: 9 ] 
Автор Сообщение
 Заголовок сообщения: Длина ломаной в тестовом поле (ctrl + f9)
СообщениеДобавлено: 01 дек 2013, 23:24 
Про настраиваемые формулы в текстовом поле слышал.
- С помощью какой пользовательской формулы можно вывести длину ломаной линии?
- Каким образом подпись сделать вдоль ломаной линии, а не в центре фигуры?

Все это необходимо чтобы видеть длины ломаных при их изменении.
Заранее спасибо.


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения: Re: Длина ломаной в тестовом поле (ctrl + f9)
СообщениеДобавлено: 01 дек 2013, 23:45 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
какая версия визио ? если 2010 или 2013 то в этой ветке был ответ

если более старая версия, то вариант только с макросом, см. здесь

не совсем понял, где должна быть надпись: неизвестно куда будет скакать это ломаная. а по умолчанию, она разумеется будет в центре фигуры

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Длина ломаной в тестовом поле (ctrl + f9)
СообщениеДобавлено: 02 дек 2013, 09:54 
Surrogate писал(а):
какая версия визио ? если 2010 или 2013 то в этой ветке был ответ

если более старая версия, то вариант только с макросом, см. здесь

не совсем понял, где должна быть надпись: неизвестно куда будет скакать это ломаная. а по умолчанию, она разумеется будет в центре фигуры

Версия 2007 и 2010 интересовала.
По поводу подписи: она должна прилипать вдоль одного из сегментов ломаной, желательно в середине.


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения: Re: Длина ломаной в тестовом поле (ctrl + f9)
СообщениеДобавлено: 02 дек 2013, 11:06 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
для вычисления длины ломаной в визио 2007 придется использовать макрос, если потом изменить ломанную данные о длине не обновятся!
Содержимое спрятано под спойлер ↓
Спойлер:
Код:
Sub dl_assign2007()
Dim sel As Selection
Dim snap1 As Shape
Set sel = ActiveWindow.Selection
If sel.Count <> 1 Then ' если не выделено ничего или больше одного будет сообщение
        MsgBox "Нужно выделить лишь одну линию!"
Exit Sub
End If
Set snap1 = sel.Item(1)
Dim dl As Double
dl = Round(KabLength(snap1) * 10) / 10
snap1.AddRow visSectionObject, visRowTextXForm, visTagDefault
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinX).FormulaU = "Width*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormWidth).FormulaU = "Width*1"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormHeight).FormulaU = "10 mm"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinX).FormulaU = "TxtWidth*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinY).FormulaU = "TxtHeight*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormAngle).FormulaU = "0 deg"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*1+TxtHeight/2"
    Dim vsoCharacters2 As Visio.Characters
    Set vsoCharacters2 = snap1.Characters
    vsoCharacters2.Begin = 0
    vsoCharacters2.End = 0
    vsoCharacters2.AddCustomFieldU Chr(34) & dl & Chr(34), visFmtNumGenNoUnits
End Sub
Function KabLength(Shap As Shape) As Double
Dim i As Integer
Dim Summa As Double ' сумма длин
Dim dx As Double, dy As Double ' определяем разности координат между концами отрезка
Dim nRows As Integer  ' счетчик количества изломов линии
nRows = Shap.RowCount(visSectionFirstComponent) - 1
Summa = 0
For i = 1 To nRows - 1  ' пошагово перебираются узлы линии и вычисляются расстояния между узлами:
dx = (Shap.CellsSRC(visSectionFirstComponent, i, 0) - Shap.CellsSRC(visSectionFirstComponent, i + 1, 0)) * 0.0254 * 1000 ' по оси X
dy = (Shap.CellsSRC(visSectionFirstComponent, i, 1) - Shap.CellsSRC(visSectionFirstComponent, i + 1, 1)) * 0.0254 * 1000 ' по оси Y
Summa = Summa + Sqr(dx ^ 2 + dy ^ 2) ' Вычисляем длину текущего отрезка и прибавляем к сумме длин предыдущих отрезков
Next
KabLength = Summa
End Function

для визио 2010 используем штатную фичу визио, если потом изменить ломанную данные о длине обновятся!
Содержимое спрятано под спойлер ↓
Спойлер:
Код:
Sub dl_assign2010()
Dim sel As Selection
Dim snap1 As Shape
Set sel = ActiveWindow.Selection
If sel.Count <> 1 Then ' если не выделено ничего или больше одного будет сообщение
        MsgBox "Нужно выделить лишь одну линию!"
Exit Sub
End If
Set snap1 = sel.Item(1)
snap1.AddRow visSectionObject, visRowTextXForm, visTagDefault
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinX).FormulaU = "Width*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormWidth).FormulaU = "Width*1"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormHeight).FormulaU = "10 mm"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinX).FormulaU = "TxtWidth*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinY).FormulaU = "TxtHeight*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormAngle).FormulaU = "0 deg"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*1+TxtHeight/2"
    Dim vsoCharacters2 As Visio.Characters
    Set vsoCharacters2 = snap1.Characters
    vsoCharacters2.Begin = 0
    vsoCharacters2.End = 0
    vsoCharacters2.AddCustomFieldU "=PATHLENGTH(Geometry1.Path,0)*25.4", visFmtNumGenNoUnits
End Sub

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Длина ломаной в тестовом поле (ctrl + f9)
СообщениеДобавлено: 02 дек 2013, 16:09 
Surrogate писал(а):
для вычисления длины ломаной в визио 2007 придется использовать макрос, если потом изменить ломанную данные о длине не обновятся!
Содержимое спрятано под спойлер ↓
Спойлер:
Код:
Sub dl_assign2007()
Dim sel As Selection
Dim snap1 As Shape
Set sel = ActiveWindow.Selection
If sel.Count <> 1 Then ' если не выделено ничего или больше одного будет сообщение
        MsgBox "Нужно выделить лишь одну линию!"
Exit Sub
End If
Set snap1 = sel.Item(1)
Dim dl As Double
dl = Round(KabLength(snap1) * 10) / 10
snap1.AddRow visSectionObject, visRowTextXForm, visTagDefault
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinX).FormulaU = "Width*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormWidth).FormulaU = "Width*1"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormHeight).FormulaU = "10 mm"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinX).FormulaU = "TxtWidth*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinY).FormulaU = "TxtHeight*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormAngle).FormulaU = "0 deg"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*1+TxtHeight/2"
    Dim vsoCharacters2 As Visio.Characters
    Set vsoCharacters2 = snap1.Characters
    vsoCharacters2.Begin = 0
    vsoCharacters2.End = 0
    vsoCharacters2.AddCustomFieldU Chr(34) & dl & Chr(34), visFmtNumGenNoUnits
End Sub
Function KabLength(Shap As Shape) As Double
Dim i As Integer
Dim Summa As Double ' сумма длин
Dim dx As Double, dy As Double ' определяем разности координат между концами отрезка
Dim nRows As Integer  ' счетчик количества изломов линии
nRows = Shap.RowCount(visSectionFirstComponent) - 1
Summa = 0
For i = 1 To nRows - 1  ' пошагово перебираются узлы линии и вычисляются расстояния между узлами:
dx = (Shap.CellsSRC(visSectionFirstComponent, i, 0) - Shap.CellsSRC(visSectionFirstComponent, i + 1, 0)) * 0.0254 * 1000 ' по оси X
dy = (Shap.CellsSRC(visSectionFirstComponent, i, 1) - Shap.CellsSRC(visSectionFirstComponent, i + 1, 1)) * 0.0254 * 1000 ' по оси Y
Summa = Summa + Sqr(dx ^ 2 + dy ^ 2) ' Вычисляем длину текущего отрезка и прибавляем к сумме длин предыдущих отрезков
Next
KabLength = Summa
End Function

для визио 2010 используем штатную фичу визио, если потом изменить ломанную данные о длине обновятся!
Содержимое спрятано под спойлер ↓
Спойлер:
Код:
Sub dl_assign2010()
Dim sel As Selection
Dim snap1 As Shape
Set sel = ActiveWindow.Selection
If sel.Count <> 1 Then ' если не выделено ничего или больше одного будет сообщение
        MsgBox "Нужно выделить лишь одну линию!"
Exit Sub
End If
Set snap1 = sel.Item(1)
snap1.AddRow visSectionObject, visRowTextXForm, visTagDefault
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinX).FormulaU = "Width*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormWidth).FormulaU = "Width*1"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormHeight).FormulaU = "10 mm"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinX).FormulaU = "TxtWidth*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormLocPinY).FormulaU = "TxtHeight*0.5"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormAngle).FormulaU = "0 deg"
    snap1.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Height*1+TxtHeight/2"
    Dim vsoCharacters2 As Visio.Characters
    Set vsoCharacters2 = snap1.Characters
    vsoCharacters2.Begin = 0
    vsoCharacters2.End = 0
    vsoCharacters2.AddCustomFieldU "=PATHLENGTH(Geometry1.Path,0)*25.4", visFmtNumGenNoUnits
End Sub

Без макросов не выйдет?


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: 02 дек 2013, 16:20 
Не в сети
Ветеран

Зарегистрирован: 06 май 2013, 13:01
Сообщений: 746
Откуда: Россия
Использую Visio c: 2013
Очков репутации: 18

Добавить очки репутацииУменьшить очки репутации
xnscripter писал(а):
Без макросов не выйдет?
Surrogate писал(а):
=PATHLENGTH(Geometry1.Path,0)*25.4

PS: Surrogate, что ещё за 25.4?


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Длина ломаной в тестовом поле (ctrl + f9)
СообщениеДобавлено: 02 дек 2013, 16:25 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
собственно установить текстовое поле ?
можно ручками войти shapesheet и добавить секцию Text Transform. в ней поставить параметры:
Height = 10 mm
TxtPinY = Height*1+TxtHeight/2
Qwertiy писал(а):
PS: Surrogate, что ещё за 25.4?
В визио единицы измерения дюймы, а это коэффициент пересчета в мм :)

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: 02 дек 2013, 16:31 
Не в сети
Ветеран

Зарегистрирован: 06 май 2013, 13:01
Сообщений: 746
Откуда: Россия
Использую Visio c: 2013
Очков репутации: 18

Добавить очки репутацииУменьшить очки репутации
Surrogate писал(а):
В визио единицы измерения дюймы, а это коэффициент пересчета в мм :)

Эм.. Значение же можно в любых единицах получить, вроде?


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Длина ломаной в тестовом поле (ctrl + f9)
СообщениеДобавлено: 02 дек 2013, 16:49 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
можно
=FORMATEX(PATHLENGTH(Geometry1.Path,0),"00.0u","in","mm")
взято отсюда

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 9 ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10


Вы можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Вы можете создать форум бесплатно PHPBB3 на Getbb.Ru, Также возможно сделать готовый форум PHPBB2 на Mybb2.ru
Русская поддержка phpBB