Script for mousedown event for adding basemap

AshleyPatton — Wed, 05 Jun 2013 01:50:22 GMT

Reposted from ArcGIS for Desktop - General at the suggestion of GeoffAppleby

Hi,

I am using the following script in ArcGIS 9.1 to add basemaps using a single click on my map (i.e. whereever I click on my page, it adds the correct mapsheet for that region).

Private Sub add1k_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)

Dim pMap As IMap
Dim pMxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim m_blnMouseDown As Boolean
Dim pPoint As IPoint

Set pMxDoc = ThisDocument
Set pActiveView = pMxDoc.FocusMap
' Convert the entered point from display coordinates to map coordinates.
Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)

x = pPoint.x
y = pPoint.y
xo = 800000
yo = 800000
xd = 60000
yd = 48000
xc1 = xd / 4
yc1 = yd / 4
xc2 = xc1 / 2
yc2 = yc1 / 2
xc3 = xc2 / 5
yc3 = yc2 / 5
xc4 = xc3 / 2
yc4 = yc3 / 2

x1 = x - xo
y1 = yo + yd - y
r1 = Int(y1 / yc1) * 4 + Int(x1 / xc1) + 1

x2 = xc1 * (x1 / xc1 - Int(x1 / xc1))
y2 = yc1 * (y1 / yc1 - Int(y1 / yc1))
r2 = Int(y2 / yc2) * 2 + Int(x2 / xc2) + 1

x3 = xc2 * (x2 / xc2 - Int(x2 / xc2))
y3 = yc2 * (y2 / yc2 - Int(y2 / yc2))
r3 = Int(y3 / yc3) * 5 + Int(x3 / xc3) + 1

x4 = xc3 * (x3 / xc3 - Int(x3 / xc3))
y4 = yc3 * (y3 / yc3 - Int(y3 / yc3))
r4 = Int(y4 / yc4) * 2 + Int(x4 / xc4) + 1

Select Case r2
Case 1
s2 = "nw"
Case 2
s2 = "ne"
Case 3
s2 = "sw"
Case 4
s2 = "se"
End Select

Select Case r4
Case 1
s4 = "a"
Case 2
s4 = "b"
Case 3
s4 = "c"
Case 4
s4 = "d"
End Select

Select Case r1
Case 1
s0 = "01"
Case 2
s0 = "02"
Case 3
s0 = "03"
Case 4
s0 = "04"
Case 5
s0 = "05"
Case 6
s0 = "06"
Case 7
s0 = "07"
Case 8
s0 = "08"
Case 9
s0 = "09"
Case 10
s0 = "10"
Case 11
s0 = "11"
Case 12
s0 = "12"
Case 13
s0 = "13"
Case 14
s0 = "14"
Case 15
s0 = "15"
Case 16
s0 = "16"
End Select

Path = "U:\Home\Master GIS Data Layers\Topo Data\01K Mapsheets\01K Mapsheets_2012"
filedir = Path
FileName = Format(r1) & s2 & Format(r3) & s4 & ".dgn"

Dim pWorkspaceFactory As IWorkspaceFactory
Dim pWorkspace As IWorkspace
Set pWorkspaceFactory = New CadWorkspaceFactory
Set pWorkspace = pWorkspaceFactory.OpenFromFile(filedir, 0)

Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pWorkspace
Dim pFeatureDataset As IFeatureDataset
Set pFeatureDataset = pFeatureWorkspace.OpenFeatureDataset(FileName)

Dim pFCC As IFeatureClassContainer
Set pFCC = pFeatureDataset

Dim pFClass As IFeatureClass
Dim pCadFeatureLayer As IFeatureLayer

' Add the feature layer to the active map.
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap

'Set pFClass = pFCC.ClassByName("Polygon")
'Set pCadFeatureLayer = New CadFeatureLayer
'pCadFeatureLayer.Name = FileName & " " & pFClass.AliasName
'Set pCadFeatureLayer.FeatureClass = pFClass
'pMap.AddLayer pCadFeatureLayer

Set pFClass = pFCC.ClassByName("Polyline")
Set pCadFeatureLayer = New CadFeatureLayer
pCadFeatureLayer.Name = FileName & " " & pFClass.AliasName
Set pCadFeatureLayer.FeatureClass = pFClass
pMap.AddLayer pCadFeatureLayer

Set pFClass = pFCC.ClassByName("Annotation")
Set pCadFeatureLayer = New CadAnnotationLayer
pCadFeatureLayer.Name = FileName & " " & pFClass.AliasName
Set pCadFeatureLayer.FeatureClass = pFClass
pMap.AddLayer pCadFeatureLayer

Dim pLegendGroup As ILegendGroup
Set pLegendGroup = New LegendGroup

Dim pLegendInfo As ILegendInfo
Dim pLayer As IFeatureLayer
Dim i As Integer
Dim j As Integer

'loop through the layers and set the minus sign to plus
For i = 0 To pMap.LayerCount - 1
If (pMap.Layer(i).Name = FileName & " " & "Polyline") Then
Set pLayer = pMap.Layer(i)
Set pLegendInfo = pLayer
For j = 0 To pLegendInfo.LegendGroupCount - 1
Set pLegendGroup = pLegendInfo.LegendGroup(j)
pLegendGroup.Visible = False
Next j
End If
Next i

pMxDoc.ActiveView.Refresh
pMxDoc.UpdateContents

End Sub

This was running on all computers in the office that used 9.1 until recently. Then our IT department made some changes to our computers (no idea what they did) and all our user defined settings were gone. I added this button again (UIControl) and it works fine on my computer but my coworkers computer will not. This script has never been used in version 10 because there is no UIControl option but has always previously worked fine in 9.1.

Doe anyone have any idea what I can do to it to get it to work on my cowroker's computer? Or any idea why it stopped working. Also, if anyone knows a way to get this to run in version 10 we'd be extremly happy.

I am no expert in computers and scripting etc but I am always happy to try. Please do talk to me like am an idiot though or I won't understand these complex proceedures and jargon.

Thanks a lot!

topic Script for mousedown event for adding basemap in ArcObjects SDK Questions

Script for mousedown event for adding basemap