frmgridsettings.frm

一个不错的插件

         TabIndex        =   49
         Top             =   1200
         Width           =   735
      End
      Begin VB.Label Label14 
         Caption         =   "REQUIRED: Each grid polygon feature requires an Identifier.  Select the Text field that will hold this ID."
         Height          =   495
         Left            =   120
         TabIndex        =   47
         Top             =   720
         Width           =   4575
      End
      Begin VB.Label Label13 
         Caption         =   "Assign roles to field names."
         Height          =   255
         Left            =   120
         TabIndex        =   46
         Top             =   240
         Width           =   4575
      End
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3720
      TabIndex        =   0
      Top             =   4800
      Width           =   1095
   End
End
Attribute VB_Name = "frmGridSettings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 2006 ESRI
'
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
'
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
'
' See use restrictions at /arcgis/developerkit/userestrictions.

Option Explicit

Public m_Application As IApplication
Public GridSettings As clsCreateGrids

Public Enum intersectFileType
  ShapeFile = 0
  AccessFeatureClass = 1
  SDEFeatureClass = 2
End Enum

Private m_bIsGeoDatabase As Boolean
Private m_FileType As intersectFileType
Private m_OutputLayer As String
Private m_OutputDataset As String
Private m_OutputFClass As String
Private m_Step As Integer

Private Const c_DefaultFld_GridID = "GRID_ID"
Private Const c_DefaultFld_ColNum = "COL_NUM"
Private Const c_DefaultFld_RowNum = "ROW_NUM"
Private Const c_DefaultFld_Scale = "PLOTSCALE"

Private Sub SetControlsState()
    Dim dScale As Double
    Dim dGHeight As Double
    Dim dGWidth As Double
    Dim dStartX As Double
    Dim dStartY As Double
    Dim dEndX As Double
    Dim dEndY As Double
    Dim bValidScale As Boolean
    Dim bValidSize As Boolean
    Dim bValidTarget As Boolean
    Dim bValidIDField As Boolean
    Dim bNewFClassSet As Boolean
    Dim bValidReqdLayers As Boolean
    Dim bValidStart As Boolean
    Dim bValidEnd As Boolean
    Dim bCreatingNewFClass As Boolean
    Dim bDuplicateFieldsSelected As Boolean
    Dim pFL As IFeatureLayer
    Dim pDatasetExtent As IEnvelope
    Dim i As Integer
    
    On Error GoTo eh
    
    ' Protect against zero length string_to_double conversions
61:     If Len(lblCurrentMapScale.Caption) = 0 Then lblCurrentMapScale.Caption = "0"
62:     If Len(txtManualMapScale.Text) = 0 Then
63:         dScale = 0
64:     Else
65:         dScale = CDbl(txtManualMapScale.Text)
66:     End If
67:     If Len(txtManualGridHeight.Text) = 0 Then
68:         dGHeight = 0
69:     Else
70:         dGHeight = CDbl(txtManualGridHeight.Text)
71:     End If
72:     If Len(txtManualGridWidth.Text) = 0 Then
73:         dGWidth = 0
74:     Else
75:         dGWidth = CDbl(txtManualGridWidth.Text)
76:     End If
77:     If Len(txtStartCoordX.Text) = 0 Then
78:         dStartX = 0
79:     Else
80:         dStartX = CDbl(txtStartCoordX.Text)
81:     End If
82:     If Len(txtStartCoordY.Text) = 0 Then
83:         dStartY = 0
84:     Else
85:         dStartY = CDbl(txtStartCoordY.Text)
86:     End If
87:     If Len(txtEndCoordX.Text) = 0 Then
88:         dEndX = 0
89:     Else
90:         dEndX = CDbl(txtEndCoordX.Text)
91:     End If
92:     If Len(txtEndCoordY.Text) = 0 Then
93:         dEndY = 0
94:     Else
95:         dEndY = CDbl(txtEndCoordY.Text)
96:     End If
97: i = 1

    ' Calc values
100:     bValidScale = (optScaleSource(0).value And CDbl(lblCurrentMapScale.Caption) > 0) Or _
                  (optScaleSource(1).value And dScale > 0)
102:     bValidSize = (optGridSize(0).value) Or _
                 (optGridSize(1).value And dGHeight > 0 And dGWidth > 0)
104:     bCreatingNewFClass = optLayerSource(1).value
105:     bNewFClassSet = (Len(txtNewGridLayer.Text) > 0)
106:     bValidTarget = (cmbPolygonLayers.ListIndex > 0) Or (bCreatingNewFClass And bNewFClassSet)
107:     bValidIDField = (cmbFieldID.ListIndex >= 0)
108:     bValidReqdLayers = (chkRemoveEmpties.value = vbUnchecked) Or _
                       (chkRemoveEmpties.value = vbChecked And lstRequiredDataLayers.SelCount > 0)
110: i = 2
111:     If bValidTarget And (Not bCreatingNewFClass) Then
112:         Set pFL = FindFeatureLayerByName(cmbPolygonLayers.List(cmbPolygonLayers.ListIndex), m_Application)
113:         If pFL.FeatureClass.FeatureDataset Is Nothing Then
114:             bValidStart = True
115:             bValidEnd = True
116:         Else
117:             Set pDatasetExtent = GetValidExtentForLayer(pFL)
118:             bValidStart = ((dStartX >= pDatasetExtent.XMin) And (dStartX <= pDatasetExtent.XMax)) _
                            And _
                          ((dStartY >= pDatasetExtent.YMin) And (dStartY <= pDatasetExtent.YMax))
121:             bValidEnd = ((dEndX >= pDatasetExtent.XMin) And (dEndX <= pDatasetExtent.XMax)) _
                            And _
                        ((dEndY >= pDatasetExtent.YMin) And (dEndY <= pDatasetExtent.YMax)) _
                            And _
                        ((dEndX > dStartX) And (dEndY > dStartY))
126:         End If
127:     ElseIf bValidTarget And bCreatingNewFClass Then
128:         bValidStart = True
129:         bValidEnd = True
130:     End If
131:     bDuplicateFieldsSelected = (cmbFieldRowNum.ListIndex > 0 And cmbFieldRowNum.ListIndex = cmbFieldColNum.ListIndex) _
                            Or (cmbFieldRowNum.ListIndex > 0 And cmbFieldRowNum.ListIndex = cmbFieldMapScale.ListIndex) _
                            Or (cmbFieldColNum.ListIndex > 0 And cmbFieldColNum.ListIndex = cmbFieldMapScale.ListIndex)
134: i = 3
    
    ' Set states
    Select Case m_Step
        Case 0:     ' Set the target feature layer
139:             cmdBack.Enabled = False
140:             cmdNext.Enabled = bValidTarget And bValidReqdLayers
141:             cmdNext.Caption = "Next >"
142:             cmbPolygonLayers.Enabled = Not bCreatingNewFClass
        Case 1:     ' Set the fields to populate
144:             cmdBack.Enabled = True
145:             cmdNext.Enabled = (bValidIDField And Not bDuplicateFieldsSelected)
146:             cmbFieldID.Enabled = Not bCreatingNewFClass
147:             cmbFieldRowNum.Enabled = Not bCreatingNewFClass
148:             cmbFieldColNum.Enabled = Not bCreatingNewFClass
149:             cmbFieldMapScale.Enabled = Not bCreatingNewFClass
        Case 2:     ' Set the scale / starting_coords
151:             cmdBack.Enabled = True
152:             cmdNext.Enabled = bValidScale And bValidStart And bValidEnd
153:             If Not bCreatingNewFClass Then
154:                 cmdDatasetExtentLL.Enabled = Not (pFL.FeatureClass.FeatureDataset Is Nothing)
155:             Else
156:                 cmdDatasetExtentLL.Enabled = False
157:             End If
        Case 3:     ' Set the dataframe properties
159:             cmdBack.Enabled = True
160:             cmdNext.Enabled = bValidSize
161:             cmdNext.Caption = "Next >"
        Case 4:     ' Set the ID values
163:             cmdBack.Enabled = True
164:             cmdNext.Enabled = True
165:             cmdNext.Caption = "Finish"
        Case Else:
167:             cmdBack.Enabled = False
168:             cmdNext.Enabled = False
169:     End Select
170: i = 4
    
172:     txtManualMapScale.Enabled = optScaleSource(1).value
173:     txtManualGridWidth.Enabled = optGridSize(1).value
174:     txtManualGridHeight.Enabled = optGridSize(1).value
175:     cmbGridSizeUnits.Enabled = optGridSize(1).value
    ' Set display
177:     If bValidStart Then
178:         txtStartCoordX.ForeColor = (&H0)    ' Black
179:         txtStartCoordY.ForeColor = (&H0)
180:     Else
181:         txtStartCoordX.ForeColor = (&HFF)   ' Red
182:         txtStartCoordY.ForeColor = (&HFF)
183:     End If
184:     If bValidEnd Then
185:         txtEndCoordX.ForeColor = (&H0)      ' Black
186:         txtEndCoordY.ForeColor = (&H0)
187:     Else
188:         txtEndCoordX.ForeColor = (&HFF)     ' Red
189:         txtEndCoordY.ForeColor = (&HFF)
190:     End If
191:     If optScaleSource(1).value Then
192:         If bValidScale Then
193:             txtManualMapScale.ForeColor = (&H0)      ' Black
194:         Else
195:             txtManualMapScale.ForeColor = (&HFF)     ' Red
196:         End If
197:     End If
198:     If optGridSize(1).value Then
199:         If bValidSize Then
200:             txtManualGridWidth.ForeColor = (&H0)      ' Black
201:             txtManualGridHeight.ForeColor = (&H0)
202:         Else
203:             txtManualGridWidth.ForeColor = (&HFF)     ' Red
204:             txtManualGridHeight.ForeColor = (&HFF)
205:         End If
206:     End If
    
    Exit Sub
209:     Resume
eh:
211:     MsgBox Err.Description, vbExclamation, "SetControlsState " & i
End Sub

Private Sub chkBreak_Click()
215:     lblExampleID.Caption = GenerateExampleID
End Sub

Private Sub chkRemoveEmpties_Click()
219:     SetControlsState
End Sub

Private Sub cmbFieldColNum_Click()
223:     SetControlsState
End Sub

Private Sub cmbFieldID_Click()
227:     SetControlsState
End Sub

Private Sub cmbFieldMapScale_Click()
231:     SetControlsState
End Sub

Private Sub cmbFieldRowNum_Click()
235:     SetControlsState
End Sub

Private Sub cmbPolygonLayers_Click()
    Dim pFL As IFeatureLayer
    Dim pFields As IFields
    Dim lLoop As Long
    ' Populate the fields combo boxes
243:     If cmbPolygonLayers.ListIndex > 0 Then
244:         Set pFL = FindFeatureLayerByName(cmbPolygonLayers.List(cmbPolygonLayers.ListIndex), m_Application)
245:         Set pFields = pFL.FeatureClass.Fields
246:         cmbFieldColNum.Clear
247:         cmbFieldID.Clear
248:         cmbFieldMapScale.Clear
249:         cmbFieldRowNum.Clear
250:         cmbFieldRowNum.AddItem "<None>"
251:         cmbFieldColNum.AddItem "<None>"
252:         cmbFieldMapScale.AddItem "<None>"
253:         For lLoop = 0 To pFields.FieldCount - 1
254:             If pFields.Field(lLoop).Type = esriFieldTypeString Then
255:                 cmbFieldID.AddItem pFields.Field(lLoop).Name
256:             ElseIf pFields.Field(lLoop).Type = esriFieldTypeDouble Or _
                   pFields.Field(lLoop).Type = esriFieldTypeInteger Or _
                   pFields.Field(lLoop).Type = esriFieldTypeSmallInteger Or _
                   pFields.Field(lLoop).Type = esriFieldTypeSingle Then
260:                 cmbFieldColNum.AddItem pFields.Field(lLoop).Name
261:                 cmbFieldRowNum.AddItem pFields.Field(lLoop).Name
262:                 cmbFieldMapScale.AddItem pFields.Field(lLoop).Name
263:             End If
264:         Next
265:         cmbFieldRowNum.ListIndex = 0
266:         cmbFieldColNum.ListIndex = 0
267:         cmbFieldMapScale.ListIndex = 0
268:     End If
269:     SetControlsState
End Sub

Private Sub cmdBack_Click()
273:     m_Step = m_Step - 1
274:     If m_Step < 0 Then
275:         m_Step = 0
276:     End If
277:     SetVisibleControls m_Step
278:     SetControlsState
End Sub

Private Sub cmdClose_Click()
282:     Set m_Application = Nothing
283:     Set Me.GridSettings = Nothing
284:     Me.Hide
End Sub

Private Sub CollateGridSettings()
    Dim pMx As IMxDocument
    Dim pCreateGrid As New clsCreateGrids
    Dim pFrameElement As IElement
    Dim sDestLayerName As String
    Dim lLoop As Long
    ' Populate class
294:     If (optGridIDOrder(0).value) Then
295:         pCreateGrid.IdentifierOrder = Row_Column
296:     Else
297:         pCreateGrid.IdentifierOrder = Column_Row
298:     End If
299:     If (optRowIDType(0).value) Then
300:         pCreateGrid.RowIDType = Alphabetical
301:     Else
302:         pCreateGrid.RowIDType = Numerical
303:     End If
304:     If (optColIDType(0).value) Then
305:         pCreateGrid.ColIDType = Alphabetical
306:     Else
307:         pCreateGrid.ColIDType = Numerical
308:     End If
309:     If (optStartingIDPosition(0).value) Then
310:         pCreateGrid.IDStartPositionType = TopLeft
311:     Else
312:         pCreateGrid.IDStartPositionType = LowerLeft
313:     End If
314:     If (optScaleSource(0).value) Then
315:         pCreateGrid.MapScale = CDbl(lblCurrentMapScale.Caption)
316:     Else
317:         pCreateGrid.MapScale = CDbl(txtManualMapScale.Text)