Wendy, the code below should work,
I have mislaid my Mapbasic Vs discs so you wll have to find a willing MBer
who will compile it for you. Failing that, email me and i'll compile as V6.5
and hopefully Jacques Paris's VerMBX tool will convert it to V5.
The tool adds an option to the Query menu, when you select teh tool, you are
prompted to identify the table you are working with, a radius within which
you want teh 'search' to occur (in your case it is 0m) and whether you want
to browse the results.
you then use teh tool by making single object selections using teh standard
select tool (black arrow on main tool bar). To 'switch off' the tool
reselect it from the query menu..
most of the code just handles teh menus the main workings are in the
selchangedhandler routine...
note that this simple query returns teh original seleced item AND those in
contact with it, if you just want teh contacting objects then i'll need to
re think the code
HTH
R
code begins>>>>>>>>>>>>>>>>>>>>>>>>>>>
include "mapbasic.def"
Declare Sub Main
Declare Sub selChangedHandler
Declare sub endhandler
Declare sub followcheck
declare function OpenTabs$(ByVal OnlyMappable As Logical) As String
declare Function GetListString$(ByVal inlist as String, ByVal choice as
SmallInt,ByVal separator as String ) as String
Global bChasing, pleezfind,mybrowse As Logical
global firstpoly as object
global mydia as float
global chosentab as string
Sub Main
Create Menu "&Contact_select" As
"!FindInContact" id 887 Calling followcheck,
"(-",
"&End Application\tCtrl+M/W^M" HelpMsg "End Application." Calling EndHandler
Alter Menu ID 3 Add "Contact_select" as "Contact_select"
mydia = 0
mybrowse = true
End Sub
Sub EndHandler()
End Program
end Sub
sub followcheck
dim tabmap as logical
dim gstablist as string
dim gitab as integer
if pleezfind then 'checked so uncheck it
pleezfind = false
Alter Menu Item id 887 uncheck
else 'not checked so check it
If NumTables() < 1 Then
Note "At Least ONE table Must be Open."
exit sub
end if
tabmap = "True"
gsTabList = OpenTabs$(tabmap)
if gsTablist = "" then note "no mappable tables"
exit sub
else
Dialog Title "Choose Table"
Control StaticText Position 12,10 Title
"Table:"
Control ListBox Position 12,22 ID 1
Title gsTabList Height 50 Value 1 into gitab
control edittext position 12, 101 width 45 value
mydia into mydia
control statictext position 12, 86 title "Search
Radius (m):"
control checkbox position 12, 116 value mybrowse
into mybrowse title "Browse results"
Control OKButton
Control CancelButton
If CommandInfo(CMD_INFO_DLG_OK) Then
CHOSENtab = GetListString$(gsTabList,gitab,";")
set coordsys table chosentab
ELSE
EXIT SUB
End if
End If
pleezfind = True
Alter Menu Item id 887 check
end if
end sub
Sub selChangedHandler
Dim iCurrentsel, bigsel As Integer
dim mypoly,mypoly2 as object
if not pleezfind then
exit sub
end if
If bChasing Then
Exit Sub
End If
bChasing = True
If commandinfo(cmd_info_seltype) = 1 Then
mypoly = selection.obj
mypoly2 = buffer (mypoly, 12, mydia, "m")
select * from chosentab where obj intersects mypoly2 into myzone
if selectioninfo(sel_info_nrows) <> 0 then
if mybrowse then
Browse * from myzone
end if
else
note "No objects in search zone"
end if
End If
bChasing = False
End Sub
Function OpenTabs$(ByVal OnlyMappable As Logical) As String
Dim i, iNumOpen as smallint
Dim sTabList as string
iNumOpen = NumTables()
For i = 1 to iNumOpen
If OnlyMappable Then
If TableInfo(i,TAB_INFO_MAPPABLE) Then
sTabList = sTabList + tableinfo(i,TAB_INFO_NAME) + ";"
End If
Else
sTabList = sTabList + tableinfo(i,TAB_INFO_NAME) + ";"
End If
Next
OpenTabs$ = sTabList
End Function
Function GetListString$(ByVal inlist as String, ByVal choice as
SmallInt,ByVal separator as String ) as String
Dim i, iIndex1, iIndex2 as SmallInt
iIndex2 = 0
i = 1
While i <= choice
iIndex1 = iIndex2+1
iIndex2 = instr(iIndex1,inlist,separator)
If iIndex2 = 0 Then
GetListString$ =
right$(inlist,len(inlist)-iIndex1+1)
Else
GetListString$ =
mid$(inlist,iIndex1,iIndex2-iIndex1)
End If
i = i + 1
Wend
End Function
*********************************************************************
This e-mail message, and any files transmitted with it, are
confidential and intended solely for the use of the addressee. If
this message was not addressed to you, you have received it in error
and any copying, distribution or other use of any part of it is
strictly prohibited. Any views or opinions presented are solely those
of the sender and do not necessarily represent those of the British
Geological Survey. The security of e-mail communication cannot be
guaranteed and the BGS accepts no liability for claims arising as a
result of the use of this medium to transmit messages from or to the
BGS. . http://www.bgs.ac.uk
*********************************************************************
---------------------------------------------------------------------
List hosting provided by Directions Magazine | www.directionsmag.com |
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Message number: 11392
