All Forums
 Категория Visio
 Форум Вопросы и ответы
 Как создать объект для Rack Diagrams?
Author Previous Topic Topic Next Topic  

ZmiterIv

3 Posts

Posted - 12/29/2007 :  11:31:25
Добрый день! Как создать произвольный объект для использования с Rack Diagrams, что бы он нижней частью притягивался к юнитам рэкового шкафа? Пробовал переделывать стандартные шэйпы, но как только вношу в них изменения и группирую - они перестают прилипать к юнитам шкафа...
Спасибо.

Tumanov

Russia
1198 Posts

Posted - 12/29/2007 :  14:48:17
Для подобного притягивания нужно превратить шейп в 1-D (линию) и сместить центр тяжести в нижнюю точку.
Первое выполняется через Format / Behavior / Interaction style - Line (1-dimensional).
Для второго - через Window / Show ShepeSheet открыть шейп-лист, найти в секции Shape Transform ячейку LocPinY и записать в нее 0.
Go to Top of Page

zhuravsky

Russia
115 Posts

Posted - 12/30/2007 :  14:02:59
А теперь по теме.
Я при решении похожей задачи столкнулся с тем, что если в шейпе больше чем 23-24 (точно не помню) графических объектов, то перестают срабатывать Glue points.
В итоге я написал макрос для принудительной приклейки такого шейпа и поместил его вызов в поле EventXFMod.
Могу поискать и прислать.
Go to Top of Page

ZmiterIv

3 Posts

Posted - 01/03/2008 :  07:35:38
Tumanov
Спасибо, работает! Помогли!

zhuravsky
Если не сложно, макрос и подробное описание как его использовать! ZmiterIv(a)tut.by
Спасибо!
Go to Top of Page

zhuravsky

Russia
115 Posts

Posted - 01/04/2008 :  17:31:03
Выслал трафарет тов. Tumanov`у. Он обещал выложить в раздел загрузка.
Идея макроса была такая:
Есть шейп для монтажного каракаса контроллера, нужно было, чтобы шейпы модулей контроллера вставлялись точно на предназначенные для них места и там приклеивались.
Макрос просто вычислял положение коннэкшен поит на шейпе платы контроллера и находил ближайшую к нему коннэкшен поинт в каркасе.
После этого вычислялось расстояние между точками, и если это расстояние "невелико", то один шейп приклеивался к другому методом GlueTo. Вызов макроса помещен в шейп шит в раздел Events.
В принципе, Визио само так приклеивает, но почему-то, если шейп "большой", то механизмы Визио перестают срабатывать.
А вот код:

Option Explicit

Const Tolerance = 10#
Const DefaultUndoStr = "Glue"
'
' Distance between two points
'
Private Function Distance(ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double) As Double
Distance = Sqr(((X2 - X1) ^ 2) + ((Y2 - Y1) ^ 2))
End Function

'
' Gets all connection points of the shape and return their coordinates
' in XPnts and YPnts collections
'
Private Sub GetConnectionPoints(Shp As Visio.Shape, XPnts As Collection, YPnts As Collection)
Dim X As Double, Y As Double
Dim DX As Double, DY As Double
Dim visSect As Integer, visRow As Integer, N As Integer
'
On Error GoTo Exit_Sub
'
' empty collections
For N = 1 To XPnts.count
XPnts.Remove 1
YPnts.Remove 1
Next N
'
visSect = visSectionConnectionPts
visRow = visRowConnectionPts
DX = Shp.Cells("PinX").Result(visDrawingUnits) - Shp.Cells("LocPinX").Result(visDrawingUnits)
DY = Shp.Cells("PinY").Result(visDrawingUnits) - Shp.Cells("LocPinY").Result(visDrawingUnits)
'
Do While Shp.RowExists(visSect, visRow, 0)
X = Shp.CellsSRC(visSect, visRow, visCnnctX).Result(visDrawingUnits) + DX
Y = Shp.CellsSRC(visSect, visRow, visCnnctY).Result(visDrawingUnits) + DY
XPnts.Add X
YPnts.Add Y
'
visRow = visRow + 1
Loop
Exit_Sub:
Resume Next
End Sub
'
' Returns a cell for glueing Shp (the nearest connection point for Shp)
' Note! Does not check the type of connection point (inward/outward)
'
Private Function GetNearestConnPtEx(Shp As Visio.Shape) As Visio.Cell
Dim Dist As Double, OldDist As Double
Dim I As Integer, J As Integer
Dim XPnts As New Collection, YPnts As New Collection
Dim X1 As New Collection, Y1 As New Collection
Dim visShp As Visio.Shape
Dim visCell As Visio.Cell
'
Dist = 0
OldDist = 1.79769313486231E+308
Set visCell = Nothing
GetConnectionPoints Shp, X1, Y1
If X1.count <= 0 Then Exit Function
'
'loop for all shapes on the page
'
For Each visShp In Shp.ContainingPage.Shapes
If visShp.ID <> Shp.ID <> 0 Then
GetConnectionPoints visShp, XPnts, YPnts
'
'loop for all connection points in shape
'
For I = 1 To XPnts.count
Dist = Sqr(((XPnts(I) - X1(1)) ^ 2) + ((YPnts(I) - Y1(1)) ^ 2))
If Dist < OldDist Then
Set visCell = visShp.Cells("Connections.X" & I)
OldDist = Dist
End If
Next I
End If
Next
Set GetNearestConnPtEx = visCell
End Function
'
' GlueShape glues the shape Shp to the nearest connection point
' Have to be used in CALLTHIS function of the Action section of ShapeSheet
' Examples: CALLTHIS("ThisDocument.GlueShape")
' CALLTHIS("ThisDocument.GlueShape", "MyTemplate")
' CALLTHIS("ThisDocument.GlueShape", "MyTemplate", "Install in Slot")
'
Public Sub GlueShape(Shp As Visio.Shape, Optional strUndo As String = DefaultUndoStr)
Dim visCell As Visio.Cell
Dim UndoID As Long
'
UndoID = ActiveDocument.BeginUndoScope(strUndo)
On Error GoTo Exit_Sub
'
Set visCell = GetNearestConnPtEx(Shp)
If Not (visCell Is Nothing) Then
Shp.Cells("Connections.X1").GlueTo visCell
End If
ActiveDocument.EndUndoScope UndoID, True
Exit Sub
Exit_Sub:
ActiveDocument.EndUndoScope UndoID, False
End Sub
'
' GlueShapeXF glues the shape Shp to the nearest connection point
' Have to be used in CALLTHIS function of the EventXFMod cell of ShapeSheet
' Tolerance_mm - is threshold for glueing in millimeters
' Examples: CALLTHIS("ThisDocument.GlueShapeXF")
' CALLTHIS("ThisDocument.GlueShapeXF", "MyTemplate")
' CALLTHIS("ThisDocument.GlueShapeXF", "MyTemplate", 100)
'
Public Sub GlueShapeXF(Shp As Visio.Shape, Optional ByVal Tolerance_mm As Double = Tolerance)
Dim visCellX As Visio.Cell, visCellY As Visio.Cell
Dim visShp As Visio.Shape
Dim X As Double, Y As Double, Dist As Double
Dim X1 As New Collection, Y1 As New Collection
Dim count As Integer
'
' exit if already glued to prevent cyclic calculation
If Shp.Connects.count > 0 Then Exit Sub
'
On Error GoTo Exit_Sub
'
Set visCellX = GetNearestConnPtEx(Shp)
If visCellX Is Nothing Then GoTo Exit_Sub
Set visCellY = visCellX.Shape.Cells(Replace(visCellX.Name, ".X", ".Y", , , vbTextCompare))
Set visShp = visCellX.Shape
'
X = visCellX.Result(visDrawingUnits)
X = X + visShp.Cells("PinX").Result(visDrawingUnits) - visShp.Cells("LocPinX").Result(visDrawingUnits)
Y = visCellY.Result(visDrawingUnits)
Y = Y + visShp.Cells("PinY").Result(visDrawingUnits) - visShp.Cells("LocPinY").Result(visDrawingUnits)
'
GetConnectionPoints Shp, X1, Y1
Dist = Distance(X, Y, X1(1), Y1(1))
If (Dist <= Tolerance_mm) Then
GlueShape Shp
End If
Exit_Sub:
Resume Next
End Sub
Go to Top of Page

Tumanov

Russia
1198 Posts

Posted - 01/05/2008 :  12:38:51
Трафарет выложил в http://visio.artberg.ru/store/Simatic_S7_400.zip
и картинку в http://visio.artberg.ru/store/simatic.png
Go to Top of Page
  Previous Topic Topic Next Topic  
Данный сайт является архивом форума visio.artberg.ru, который был закрыт в связи с переходом на новую платформу visio.getbb.ru
Все материалы доступны только для чтения! Если у вас появились вопросы, или вы хотите что-то обсудить, связанное с Visio, обращайтесь на новый форум!
Архив был создан благодаря совместным усилиям Генадия Туманова @Tumanov (visio.artberg.ru), Александра ака @Surrogate (visio.getbb.ru), и Николая Белых @nbelyh (unmanagedvisio.com)