POST
|
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!
... View more
06-04-2013
06:50 PM
|
0
|
0
|
491
|
Online Status |
Offline
|
Date Last Visited |
11-11-2020
02:24 AM
|