AVAX-software.com Forums: coordinates of Command.Nearest_c - AVAX-software.com Forums

Jump to content

Page 1 of 1

coordinates of Command.Nearest_c

#1 User is offline   MarioRainer Icon

  • Advanced Member
  • PipPipPip
  • Group: Members
  • Posts: 32
  • Joined: 11-May 08
  • Location:Germany

Posted 09 February 2010 - 07:53 AM

hello,

is it possible do get the coordinates of Command.Nearest_c?

friendly

MarioRainer

#2 User is offline   Athanasios Gardos Icon

  • Administrator
  • Icon
  • Group: Admin
  • Posts: 328
  • Joined: 21-March 05
  • Gender:Male

Posted 09 February 2010 - 11:59 AM

Hi,

Have a look at the following VB6 source code:
Option Explicit

Private Function Distance(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Single
    Distance = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function

Private Sub cAvax1_BeforeClick(Button As Integer, Shift As Integer, x As Long, y As Long, ClickType As Avax.AvaxClickType, fCancel As Boolean)
    Dim xp As Single, yp As Single
    Dim h() As Long, iType() As AvaxItemType
    Dim vProp() As Variant, vData() As Variant
    Dim xyz() As Single, M As Long
    Dim xV() As Single, yV() As Single, zV() As Single
    Dim lMax As Long, lCnt As Long, jCnt As Long
    Dim xSecp As Single, ySecp As Single
    Dim lCount As Long
    Dim Dist As Single, minDist As Single
    Dim NearestPointX As Single, NearestPointY As Single, NearestPointZ As Single
    Dim PolylineCnt As Long
    Call cAvax1.CurrentXY(xp, yp)
    lMax = cAvax1.GetAllHandlesArr(h(), Polyline_i)
    PolylineCnt = 0
    minDist = -1
    If lMax > 0 Then
       If cAvax1.GetProperties(h(), iType(), vProp(), vData()) = True Then
          For lCnt = 1 To lMax
              If iType(lCnt) = Polyline_i Then
                 PolylineCnt = PolylineCnt + 1
                 xyz() = vData(lCnt)
                 M = UBound(xyz()) / 6
                 ReDim xV(M) As Single, yV(M) As Single, zV(M) As Single
                 lCount = 0
                 For jCnt = 1 To UBound(xyz()) Step 6
                     lCount = lCount + 1
                     If lCount > 1 Then
                        If xyz(jCnt) <> xSecp Or xyz(jCnt + 1) <> ySecp Then GoTo Lab_Next
                     End If
                     xV(lCount) = xyz(jCnt)
                     yV(lCount) = xyz(jCnt + 1)
                     xSecp = xyz(jCnt + 3)
                     ySecp = xyz(jCnt + 4)
                 Next jCnt
                 lCount = lCount + 1
                 ReDim Preserve xV(lCount) As Single
                 ReDim Preserve yV(lCount) As Single
                 ReDim Preserve zV(lCount) As Single
                 xV(lCount) = xSecp
                 yV(lCount) = ySecp
                 If lCount > 0 Then
                    If PolylineCnt = 1 Then
                       minDist = Distance(xp, yp, xV(1), yV(1))
                       NearestPointX = xV(1)
                       NearestPointY = yV(1)
                       NearestPointZ = zV(1)
                    End If
                    For jCnt = 1 To lCount
                        Dist = Distance(xp, yp, xV(jCnt), yV(jCnt))
                        If Dist < minDist Then
                           minDist = Dist
                           NearestPointX = xV(jCnt)
                           NearestPointY = yV(jCnt)
                           NearestPointZ = zV(jCnt)
                        End If
                    Next jCnt
                    
                 End If
              End If
Lab_Next:
          Next lCnt
          If minDist <> -1 Then Call cAvax1.Add_Point(NearestPointX, NearestPointY, NearestPointZ, , , 2, 3)
       End If
    End If
End Sub

Private Sub Form_Load()
    Dim x() As Single, y() As Single, z() As Single
    Call cAvax1.StartAvax
    ReDim x(4) As Single, y(4) As Single, z(4) As Single
    x(1) = 0
    y(1) = 0
    x(2) = 10
    y(2) = 0
    x(3) = 10
    y(3) = 10
    x(4) = 20
    y(4) = 10
    Call cAvax1.Add_PolyLine(x(), y(), z())
    Call cAvax1.Add_Rectangle(2, 2, 5, 3)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call cAvax1.EndAvax
End Sub

Athanasios Gardos
Avax-Software.com

Page 1 of 1


Fast Reply

  

1 User(s) are reading this topic
0 members, 1 guests, 0 anonymous users