Чего нам и вам не хватает в стандартных средствах Visio ?

Surrogate

Данная ветка является логическим продолжением дискуссии начатой чуть ранее.

9rey в сообщении #5717 писал(а):

вообще интересно, какие еще фишки людям хотелось бы добавить в визио? может например дотянуть линию до объекта? или обрезать? и т.п.

думаю удлинить/обрезать точно нужны!
кабы это еще все загнать в аддин, можно удостоиться упоминание самой Аллы Васильевой. Например так

Alla Vasilieva 11 Jun 2014 1:21 AM в русскоязычном блоге Visio писал(а):

Операции с «базовой точкой»
Во многих чертежных продуктах существуют так называемые операции с «базовой точкой». В частности, а AutoCad есть «копирование с базовой точкой», «перемещение с базовой точкой».
Данная операция может быть очень полезна для точного позиционирования вставляемого (перемещаемого) объекта.
Подробнее…

Так что есть куда копать.

Друзья поделитесь мнением чего вам не хватает, и если уже есть готовые "дополнительные возможности" дополняйте эту ветку.

Выделение секущей рамкой аля AutoCad
Таблицы в Visio
Работа с графами
Надстройка SelectShape, аналог QuickSelect в Autocad
Надстройка CopyProperties, копирование свойств шейпа

Tumanov

Цитата:

возможно что-то такое было в версии Technical

Насколько я помню, ничего особенного не было. Все эти варианты поставки являются лишь разными нарезками одних и тех же дополнений и трафаретов. В каждой версии их по разному нарезают. Но до 2013 ничего не выкидывалось. "Упрощать" Visio начали только в версии 2013.

Цитата:

но у меня специфика просто такая.
а вообще в автокаде то постоянно такое нужно.

9rey, я спрашивал на предмет - не удастся ли использовать имеющиеся средства Visio. К этой задаче близки две вещи: так называемое "расширение фигур" и функция IntersectX в шейп-листе. Они ведь как раз ищут точку пересечения продолжения линий. Если бы удалось приспособить то или другое, не надо было бы самим высчитывать все эти формулы и особые случаи типа деления на 0. Но вот к Вашему примеру вроде ни то, ни другое не клеится. Хотя, может это только на первый взгляд...

9rey

Tumanov, в моем случае я привязывался к определенным точкам подключения, их еще найти надо программно, и прочие мелочи.
а можно подробнее про "расширение фигур"?

Surrogate

у меня первая мысль была сделать так.
1. создать копию секущей линии
2. создать копию удлиняемой линии, удлинить ее до края листа в нужном
направлении (с поисками направления. дошел до геометрического решения
с линиями)
3. операцией трим, обрезать отрезок. найти точку пересечения (вот как не
придумал)
4. удлинить удлиняемую линию, до найденной точки пересечения.
5. удалить обрезки полученные в результате операции п. 3 (и это тоже вопрос)

Surrogate

MSDN в статье INTERSECTY Function писал(а):

INTERSECTY Function
Returns the y-coordinate (in the local coordinate system) of the point where two lines intersect. Each line is defined as a point (x,y) and an angle.

Syntax

INTERSECTX(x1,y1,angle1,x2,y2,angle2)
Remarks

Microsoft Office Visio uses this function in the PinY cell of a shape glued to a rotated guide.

If the lines don't intersect, the function returns a divide-by-zero error (#DIV/0!), which Visio ignores, restoring the last known value for the point.

по ходу это тоже будеть работать только с линиями (1-d) ?

9rey

Surrogate писал(а):

по ходу это тоже будеть работать только с линиями (1-d) ?

да, с коннекторами видимо не пройдет.
да и как прикрутить INTERSECTX? нам же не шейпшит нужен, а через код.

Surrogate

с помощью IntersectX и IntersectY можно вычислить координату пересечения пары линий средствами самого визио, а не писать код с геометрическими вычислениями как я

9rey

Surrogate писал(а):

с помощью IntersectX и IntersectY можно вычислить координату пересечения пары линий средствами самого визио, а не писать код с геометрическими вычислениями как я

это все понятно.
как ты себе представляешь инструмент, работающий на этих ф-ях? т.е. мне чтоб произвести обрезку/удлиннение надо каждый раз в эти линии пихать эти функции? а дальше как? вообще не очень представляю как это будет работать через шейпшит

Surrogate

для промежуточныъх вычислений используются ячейки User.IntersectX и User.IntersectY активного листа.

Код:

Sub Geometry_Base()
Dim f_sh As Shape, s_sh As Shape, I%
Dim wn As Window
Dim xpos$, ypos$, CH_X As Cell, CH_y As Cell
Set f_sh = ActiveWindow.Selection(1)
For I = 2 To ActiveWindow.Selection.Count
Set s_sh = ActiveWindow.Selection(I)
Dim x_cell As Cell, y_cell As Cell
Set wn = Application.ActiveWindow.Page.PageSheet.OpenSheetWindow
wn.Shape.Cells("user.intersecty").FormulaU = "=intersecty(sheet." & f_sh.ID & "!BeginX,sheet." & f_sh.ID & "!BeginY,sheet." & f_sh.ID & "!Angle,sheet." & s_sh.ID & "!BeginX,sheet." & s_sh.ID & "!BeginY,sheet." & s_sh.ID & "!Angle)"
y = wn.Shape.Cells("user.intersecty").Result(65)
wn.Shape.Cells("user.intersectx").FormulaU = "=intersectx(sheet." & f_sh.ID & "!BeginX,sheet." & f_sh.ID & "!BeginY,sheet." & f_sh.ID & "!Angle,sheet." & s_sh.ID & "!BeginX,sheet." & s_sh.ID & "!BeginY,sheet." & s_sh.ID & "!Angle)"
x = wn.Shape.Cells("user.intersectx").Result(65)
wn.Close
' x и y найденные точки пересечения
If s_sh.Cells("EndX").Result(65) - x < s_sh.Cells("BeginX").Result(65) - x Then
Set CH_X = s_sh.Cells("EndX")
Set CH_y = s_sh.Cells("Endy")
Else
Set CH_X = s_sh.Cells("BeginX")
Set CH_y = s_sh.Cells("Beginy")
End If
xpos = Replace(x & " mm", ",", ".")
ypos = Replace(y & " mm", ",", ".")
CH_X.FormulaU = xpos
CH_y.FormulaU = ypos
Next I
End Sub

костыль конечно

Tumanov

Ой, а у меня буковок меньше получилось..

Код:

Dim sh1 As Visio.Shape, sh2 As Visio.Shape
Sub ttt()
    Set sh1 = ActiveWindow.Selection(1): Set sh2 = ActiveWindow.Selection(2)
    With ActivePage.PageSheet
        .Cells("Scratch.X1") = sh1.Cells("BeginX")
        .Cells("Scratch.Y1") = sh1.Cells("BeginY")
        .Cells("Scratch.A1") = sh1.Cells("Angle")
        .Cells("Scratch.X2") = sh2.Cells("BeginX")
        .Cells("Scratch.Y2") = sh2.Cells("BeginY")
        .Cells("Scratch.A2") = sh2.Cells("Angle")
        sh2.Cells("EndX") = .Cells("Scratch.X3")
        sh2.Cells("EndY") = .Cells("Scratch.Y3")
    End With
End Sub

Это потому, что я саму формулу заранее в шейп-лист запихал

Tumanov

Цитата:

костыль конечно

Для общего случая - да.
Но представьте себе, что кому-то понадобится линия, которая может "дотягиваться" куда надо. Вот тогда Intersect может очень даже пригодиться.
Потому я и интересовался, для какого применения это нужно.

Цитата:

а можно подробнее про "расширение фигур"?

Это они так на русский Shape Extensions перевели.
Если в Visio включить нужные галочки, то из шейпов начинают всякие пуктирные линии расти. Как я понимаю, этим пользуются редко, потому как чаще всего они только раздражают. Но пересечения находят.
Примерно вот так. https://www.dropbox.com/s/un9qdiukk3iti ... n.avi?dl=0

Surrogate

Tumanov писал(а):

Это они так на русский Shape Extensions перевели.
Если в Visio включить нужные галочки, то из шейпов начинают всякие пуктирные линии расти. Как я понимаю, этим пользуются редко, потому как чаще всего они только раздражают. Но пересечения находят.

А программно-то это как можно использовать ?
с помощью этой фичи можно руками дотянуть линию, до нужного места.
а фича из автокада позволяет дотянуть до "секущей" линии (той линии что была выбрана первой) сразу несколько линий!

Tumanov

То есть нужно именно то, что на этой картинке?
Кстати, а что происходит, когда расширяющаяся линия не встретит цели? Уходит в край листа?

Surrogate

ничего не происходит ! если пересечения не произойдет в пределах активной области просмотра.
в автокаде есть 3 операции Обрезать/Удлинить/Сопряжение

Обрезать	Удлинить	Сопряжение

вот как раз Сопряжение продлит обе линии до точки их пересечения

Tumanov

Уж не хотите ли Вы перенести в Visio весь этот тулбар?

Surrogate

нет. это уже перебор будет

9rey

Tumanov, Surrogate, красавцы! благодаря вам узнал о двух классных фичах: о "расширениях фигур" и в автокаде "сопряжение"! буду активно пользоваться

Tumanov

Можно попробовать вот такой прием:

Код:

Dim WithEvents pg As Visio.Page
Dim Garbage As Collection

Dim sh1 As Visio.Shape, sh2 As Visio.Shape
Dim sh3 As Visio.Shape, sh4 As Visio.Shape

Sub ttt()
    Set Garbage = New Collection
    Set pg = ActivePage     'Включить сбор мусора
    Set sh1 = ActiveWindow.Selection(1)
    Set sh2 = ActiveWindow.Selection(2)
    Set sh3 = sh1.Duplicate     'Дубль границы (цели)
    sh3.Cells("PinX") = sh1.Cells("PinX")
    sh3.Cells("PinY") = sh1.Cells("PinY")
    'Направляющая накрывает продлеваемую линию
    Set sh4 = ActivePage.AddGuide(2, sh2.Cells("PinX"), sh2.Cells("PinY"))
    sh4.Cells("Angle") = sh2.Cells("Angle")
    ActiveWindow.Selection.DeselectAll
    ActiveWindow.Select sh3, visSelect
    ActiveWindow.Select sh4, visSelect
    Dim sel As Visio.Selection
    Set sel = ActiveWindow.Selection
    sel.Trim    'Собственно разрез
    '(Созданные в процессе разреза шейпы соберутся в коллекцию Garbage)
    Set pg = Nothing     'Останов сбора мусора
    Debug.Print Garbage.Count
    'Удаление из коллекции шейпов, которые Visio уже удалил
    For i = Garbage.Count To 1 Step -1
        On Error Resume Next
        If Garbage(i).Type <> 3 Then Garbage.Remove i
        On Error GoTo 0
    Next
    Debug.Print Garbage.Count
    'Определение точки соединения по стыку фрагментов
    Select Case Garbage.Count
    Case 1  'Направляющая прошла мимо цели
        MsgBox "Нет пересечения"
    Case 2  'Цель рассечена надвое
        If (Garbage(1).Cells("BeginX") - Garbage(2).Cells("EndX")) < 0.001 _
        And (Garbage(1).Cells("BeginY") - Garbage(2).Cells("EndY")) < 0.001 Then
            x = Garbage(1).Cells("BeginX")
            y = Garbage(1).Cells("BeginY")
        Else    'Смотря какими концами стыкуются отрезки
            x = Garbage(1).Cells("EndX")
            y = Garbage(1).Cells("EndY")
        End If
        Set sh4 = ActivePage.AddGuide(1, x, y)
    Case Else  'Слишком много пересечений
        MsgBox "Слишком много пересечений"
    End Select
    'Удаление мусора
    On Error Resume Next
    For i = Garbage.Count To 1 Step -1
        Garbage(i).Delete   'Удаление рассеченного шейпа
        Garbage.Remove i    'Чистка коллекции
    Next
    On Error GoTo 0
    'Примечание. Направляющая в точке пересечения остается не удаленной.
End Sub

Private Sub pg_ShapeAdded(ByVal Shape As IVShape)
    Garbage.Add Shape
End Sub

Tumanov

Точка пересечения прямой и цели (прямая, кривая, ломаная) находится по реальному пересечению временных технологических шейпов - дубля цели и направляющей, накладываемой на прямую.
Цель разрежется на 2 части (не всегда). Точка пересечения будет там, где начало одного фрагмента совпадет с концом другого (по координатам).
Весь технологический мусор собирается в специальную коллекцию, потом удаляется.
Коллекция собирается в событии добавления шейпа на страницу.

Surrogate

Геннадий,
великолепно, осталось только нужный конец второго выделенного шейпа довести до sh4

Tumanov

Немножко подчистил

Код:

Dim WithEvents pg As Visio.Page 'Страница, обслуживающая событие ShapeAdded
Dim Garbage As Collection       'Коллекция для сбора технологического мусора

'Обработчик технологического мусора
Private Sub pg_ShapeAdded(ByVal Shape As IVShape)
    Garbage.Add Shape
End Sub

Sub ttt()   'Тестовая процедура для LineExtension
    LineExtension ActiveWindow.Selection(1), ActiveWindow.Selection(2)
End Sub

'Процедура продления прямой Line до линии Targ
Sub LineExtension(Targ As Visio.Shape, Line As Visio.Shape)
    Dim sh3 As Visio.Shape, sh4 As Visio.Shape
    Dim Flag As Integer
    Set Garbage = New Collection
    Set pg = ActivePage     'Включить сбор мусора
    Set sh3 = Targ.Duplicate     'Дубль границы (цели)
    sh3.Cells("PinX") = Targ.Cells("PinX")
    sh3.Cells("PinY") = Targ.Cells("PinY")
    'Направляющая накрывает продлеваемую линию
    Set sh4 = ActivePage.AddGuide(2, Line.Cells("PinX"), Line.Cells("PinY"))
    sh4.Cells("Angle") = Line.Cells("Angle")
    With ActiveWindow
        .Selection.DeselectAll
        .Select sh3, visSelect
        .Select sh4, visSelect
        .Selection.Trim    'Собственно разрез
    End With
    '(Созданные в процессе разреза шейпы соберутся в коллекцию Garbage)
    Set pg = Nothing     'Останов сбора мусора
'    Debug.Print Garbage.Count
    'Удаление из коллекции шейпов, которые Visio уже удалил
    For i = Garbage.Count To 1 Step -1
        On Error Resume Next
        If Garbage(i).Type <> 3 Then Garbage.Remove i
        On Error GoTo 0
    Next
'    Debug.Print Garbage.Count
    'Определение точки соединения по стыку фрагментов
    Flag = 0    'Признак нештатной ситуации при определении пересечения
    Select Case Garbage.Count
    Case 1  'Направляющая прошла мимо цели
        MsgBox "Нет пересечения"
    Case 2  'Цель рассечена надвое
        If (Garbage(1).Cells("BeginX") - Garbage(2).Cells("EndX")) < 0.001 _
        And (Garbage(1).Cells("BeginY") - Garbage(2).Cells("EndY")) < 0.001 Then
            x = Garbage(1).Cells("BeginX")
            y = Garbage(1).Cells("BeginY")
        Else    'Смотря какими концами стыкуются отрезки
            x = Garbage(1).Cells("EndX")
            y = Garbage(1).Cells("EndY")
        End If
        Flag = 1
'        Set sh4 = ActivePage.AddGuide(1, x, y)
    Case Else  'Слишком много пересечений
        MsgBox "Слишком много пересечений"
        'Тут еще нужно решить, что делать.
    End Select
    'Удаление мусора
    On Error Resume Next
    For i = Garbage.Count To 1 Step -1
        Garbage(i).Delete   'Удаление рассеченного шейпа
        Garbage.Remove i    'Чистка коллекции
    Next
    On Error GoTo 0
    If Flag = 0 Then Exit Sub   'Нет возможности продлить линию.
    'Продление линии до точки x, y
    If Abs(Line.Cells("BeginX") - Line.Cells("EndX")) > 0 Then
        a = x: b = Line.Cells("BeginX"): c = Line.Cells("EndX")
    Else
        a = y: b = Line.Cells("BeginY"): c = Line.Cells("EndY")
    End If
    Flag = 0
    If b < c Then   'Стрелка вверх или вправо
        If a < b Then
            Flag = 1
        ElseIf a > c Then
            Flag = 2
        End If
    Else
        If a < c Then
            Flag = 2
        ElseIf a > b Then
            Flag = 1
        End If
    End If
    If Flag = 1 Then
        Line.Cells("BeginX") = x: Line.Cells("BeginY") = y
    ElseIf Flag = 2 Then
        Line.Cells("EndX") = x: Line.Cells("EndY") = y
    End If
End Sub

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

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

Чего нам и вам не хватает в стандартных средствах Visio ?

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