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

Форум по вопросам применения и программирования в Visio
Текущее время: 20 фев 2018, 23:36

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


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


При размещении файлов предпочтительным является формат vsd (а не vsdx/vsdm)



Начать новую тему Ответить на тему  [ Сообщений: 63 ]  На страницу Пред.  1, 2, 3, 4  След.
Автор Сообщение
 Заголовок сообщения: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 14 ноя 2014, 18:50 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
Данная ветка является логическим продолжением дискуссии начатой чуть ранее.
9rey в сообщении #5717 писал(а):
вообще интересно, какие еще фишки людям хотелось бы добавить в визио? может например дотянуть линию до объекта? или обрезать? и т.п. :)
думаю удлинить/обрезать точно нужны!
кабы это еще все загнать в аддин, можно удостоиться упоминание самой Аллы Васильевой. Например так
Alla Vasilieva 11 Jun 2014 1:21 AM в русскоязычном блоге Visio писал(а):
Операции с «базовой точкой»
Во многих чертежных продуктах существуют так называемые операции с «базовой точкой». В частности, а AutoCad есть «копирование с базовой точкой», «перемещение с базовой точкой».
Данная операция может быть очень полезна для точного позиционирования вставляемого (перемещаемого) объекта.
Подробнее…
Так что есть куда копать.
Друзья поделитесь мнением чего вам не хватает, и если уже есть готовые "дополнительные возможности" дополняйте эту ветку.

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 09:53 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

Добавить очки репутацииУменьшить очки репутации
Цитата:
возможно что-то такое было в версии Technical

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

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 10:09 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 884
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 118

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 11:43 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
у меня первая мысль была сделать так.
1. создать копию секущей линии
2. создать копию удлиняемой линии, удлинить ее до края листа в нужном
направлении (с поисками направления. дошел до геометрического решения
с линиями)
3. операцией трим, обрезать отрезок. найти точку пересечения (вот как не
придумал)
4. удлинить удлиняемую линию, до найденной точки пересечения.
5. удалить обрезки полученные в результате операции п. 3 (и это тоже вопрос)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 12:17 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
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) ?


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 13:23 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 884
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 118

Добавить очки репутацииУменьшить очки репутации
Surrogate писал(а):
по ходу это тоже будеть работать только с линиями (1-d) ?

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 13:28 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
с помощью IntersectX и IntersectY можно вычислить координату пересечения пары линий средствами самого визио, а не писать код с геометрическими вычислениями как я


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 14:37 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 884
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 118

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

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 14:52 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
для промежуточныъх вычислений используются ячейки 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

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 19:37 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

Добавить очки репутацииУменьшить очки репутации
Ой, а у меня буковок меньше получилось.. :)
Код:
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

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 19:40 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

Добавить очки репутацииУменьшить очки репутации
Цитата:
костыль конечно

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

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 19:57 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
Tumanov писал(а):
Это они так на русский Shape Extensions перевели.
Если в Visio включить нужные галочки, то из шейпов начинают всякие пуктирные линии расти. Как я понимаю, этим пользуются редко, потому как чаще всего они только раздражают. Но пересечения находят.
А программно-то это как можно использовать ?
с помощью этой фичи можно руками дотянуть линию, до нужного места.
а фича из автокада позволяет дотянуть до "секущей" линии (той линии что была выбрана первой) сразу несколько линий!
Изображение


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 20:17 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 20:37 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
ничего не происходит ! если пересечения не произойдет в пределах активной области просмотра.
в автокаде есть 3 операции Обрезать/Удлинить/Сопряжение

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


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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 20:42 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

Добавить очки репутацииУменьшить очки репутации
Уж не хотите ли Вы перенести в Visio весь этот тулбар? :)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 20:46 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
нет. это уже перебор будет :)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 17 ноя 2014, 21:19 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 884
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 118

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 18 ноя 2014, 13:27 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

Добавить очки репутацииУменьшить очки репутации
Можно попробовать вот такой прием:
Код:
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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 18 ноя 2014, 13:33 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 18 ноя 2014, 13:52 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3362
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
Геннадий,
великолепно, осталось только нужный конец второго выделенного шейпа довести до sh4 Изображение


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Чего нам и вам не хватает в стандартных средствах Visio ?
СообщениеДобавлено: 18 ноя 2014, 17:44 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 1070
Очков репутации: 100579

Добавить очки репутацииУменьшить очки репутации
Немножко подчистил
Код:
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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 63 ]  На страницу Пред.  1, 2, 3, 4  След.

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



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

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


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

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