[harold]

With the command Add_AllDimensions I can automaticly dim a selected set of object, but it will always be dimmed on the bottom and right side of the object.
Can the function be alterd so I can choose where to set the dim lines.

For example:

Add_AllDimensions(OffsetD As Single, sSmallestDim As Single, Optional vItemProperties As Variant, Optional vRetHandles As Variant, Optional iClr As Integer = -1, Optional iWidth As Integer = -1, Optional iStyle As Integer = -1, Optional iLayer As Integer = -1,Optional iDirection as Single)

Where :
0 or 1 = BottomRight (default)
2 = BottomLeft
3 = TopRight
4 = TopLeft

Harold van Aarsen

[harold]

Sorrya The example wasn't complete, here it comes again:

For example:

Add_AllDimensions(OffsetD As Single, sSmallestDim As Single, Optional vItemProperties As Variant, Optional vRetHandles As Variant, Optional iClr As Integer = -1, Optional iWidth As Integer = -1, Optional iStyle As Integer = -1, Optional iLayer As Integer = -1, Optional iDirection as Single)

Where iDirection =
0 or 1 = BottomRight (default)
2 = BottomLeft
3 = TopRight
4 = TopLeft

[Athanasios Gardos]

The code that AVAX uses to put all the dimensions is something like this:

Function AddAllDimensions(OffsetD As Single, sSmallestDim As Single, Optional vItemProperties As Variant, Optional vRetHandles As Variant, Optional iClr As Integer = -1, Optional iWidth As Integer = -1, Optional iStyle As Integer = -1, Optional iLayer As Integer = -1) As Boolean
    Dim x() As Single, y() As Single, DimPoints() As Single
    Dim lMaxDim As Long, i&, j&, dd As Single
    Dim xDim As Single, yDim As Single, lCount As Long
    Dim RetH() As Long, lCnt As Long, lCntD As Long
    Dim mh1 As Long, mh2 As Long
    Dim xMin As Single, yMin As Single
    Dim xMax As Single, yMax As Single
    Dim z1 As Single, z2 As Single
    Dim sProperties() As String
    Dim RetHandles() As Long
    Dim fOld As Boolean
    If IsMissing(vItemProperties) = False Then
       If VarType(vItemProperties) = (vbArray Or vbString) Then
          sProperties() = vItemProperties
       End If
    End If
    If OffsetD <= 0 Then OffsetD = 1
    If iClr = -1 Then iClr = cAvax1.pencolor
    If iWidth = -1 Then iWidth = cAvax1.PenWidth
    If iStyle = -1 Then iStyle = cAvax1.PenLineStyle
    If iLayer = -1 Then iLayer = cAvax1.PenLayer
    mh1 = cAvax1.lastHandle
    Call cAvax1.CalcBoundsDrawing
    Call cAvax1.GetBoundsDrawing(xMin, yMin, z1, xMax, yMax, z2)
    If OffsetD <= 0 Then OffsetD = 1
    yDim = yMin
    xDim = xMax
    If cAvax1.GetAllNodes(x(), y()) = True Then
       fOld = cAvax1.AutoRedraw
       cAvax1.AutoRedraw = False
       '---- &times;
       DimPoints() = x()
Lab_Again1:
       lMaxDim = UBound(DimPoints)
       If sSmallestDim <> 0 Then
          If lMaxDim > 1 Then
              For i& = 1 To lMaxDim - 1
                  dd = DimPoints(i& + 1) - DimPoints(i&)
                  If dd < sSmallestDim Or IsZero(dd - sSmallestDim) = True Then
                     For j& = i& + 1 To lMaxDim - 1
                         Swap DimPoints(j&), DimPoints(j& + 1)
                     Next j&
                     ReDim Preserve DimPoints(lMaxDim - 1) As Single
                     GoTo Lab_Again1
                  End If
              Next i&
          End If
          lMaxDim = UBound(DimPoints)
       End If
       lCntD = 0
       If lMaxDim > 1 Then
           For i& = 1 To lMaxDim - 1
              If cAvax1.Add_Dim(DimPoints(i&), yDim, DimPoints(i& + 1), yDim, OffsetD, (xMax - xMin) / 2, yMin - 2 * OffsetD, sProperties(), RetH(), iClr, iWidth, iStyle, iLayer) = True Then
                 lCntD = lCntD + 1
              End If
           Next i&
           If lCntD <> 1 Then
              Call cAvax1.Add_Dim(DimPoints(1), yDim, DimPoints(lMaxDim), yDim, 2 * OffsetD, (xMax - xMin) / 2, yMin - 4 * OffsetD, sProperties(), RetH(), iClr, iWidth, iStyle, iLayer)
           End If
       End If
       '---- &Otilde;
       DimPoints() = y()
Lab_Again2:
       lMaxDim = UBound(DimPoints)
       If sSmallestDim <> 0 Then
          If lMaxDim > 1 Then
              For i& = 1 To lMaxDim - 1
                  dd = DimPoints(i& + 1) - DimPoints(i&)
                  If dd < sSmallestDim Or IsZero(dd - sSmallestDim) = True Then
                     For j& = i& + 1 To lMaxDim - 1
                         Swap DimPoints(j&), DimPoints(j& + 1)
                     Next j&
                     ReDim Preserve DimPoints(lMaxDim - 1) As Single
                     GoTo Lab_Again2
                  End If
              Next i&
          End If
          lMaxDim = UBound(DimPoints)
       End If
       lCntD = 0
       If lMaxDim > 1 Then
           For i& = 1 To lMaxDim - 1
              If cAvax1.Add_Dim(xDim, DimPoints(i&), xDim, DimPoints(i& + 1), OffsetD, xMax + 2 * OffsetD, (yMax - yMin) / 2, sProperties(), RetH(), iClr, iWidth, iStyle, iLayer) = True Then
                 lCntD = lCntD + 1
              End If
           Next i&
           If lCntD <> 1 Then
              Call cAvax1.Add_Dim(xDim, DimPoints(1), xDim, DimPoints(lMaxDim), 2 * OffsetD, xMax + 4 * OffsetD, (yMax - yMin) / 2, sProperties(), RetH(), iClr, iWidth, iStyle, iLayer)
           End If
       End If
       cAvax1.AutoRedraw = fOld
    End If
    mh2 = cAvax1.lastHandle
    If mh2 > mh1 Then
       ReDim RetHandles(mh2 - mh1) As Long
       lCount = 0
       For lCnt = mh2 - mh1 To 1 Step -1
           lCount = lCount + 1
           RetHandles(lCnt) = mh2 - lCount + 1
       Next lCnt
       AddAllDimensions = True
       vRetHandles = RetHandles()
    End If
End Function

Private Function IsZero(A As Single) As Boolean
    If Abs(A) < 0.0001 Then IsZero = True Else IsZero = False
End Function

Private Sub Swap(A As Single, B As Single)
    Dim C As Single
    C = B
    B = A
    A = C
End Sub

I believe that it will be easy to you to modify this code and make your own function