| Author |
 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. |
 |
|
|
zhuravsky
Russia
115 Posts |
Posted - 12/30/2007 : 14:02:59
|
А теперь по теме.
Я при решении похожей задачи столкнулся с тем, что если в шейпе больше чем 23-24 (точно не помню) графических объектов, то перестают срабатывать Glue points.
В итоге я написал макрос для принудительной приклейки такого шейпа и поместил его вызов в поле EventXFMod.
Могу поискать и прислать. |
|
|
|
ZmiterIv
3 Posts |
Posted - 01/03/2008 : 07:35:38
|
Tumanov
Спасибо, работает! Помогли!
zhuravsky
Если не сложно, макрос и подробное описание как его использовать! ZmiterIv(a)tut.by
Спасибо! |
|
|
|
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
|
|
|
|
Tumanov
Russia
1198 Posts |
|
| |
Topic |
|
|
|
All Forums
Как создать объект для Rack Diagrams?