frmmapserieswiz.frm

一个不错的插件

304:   Set pSeriesOpt3 = pSeriesOpt    'Added 11/23/04
305:   Set pSeriesProps = pMapSeries
306:   pMapSeries.EnableSeries = True
  
  'Find the detail frame
309:   Set pMap = FindDataFrame(pDoc, cmbDetailFrame.Text)
310:   If pMap Is Nothing Then
311:     MsgBox "Detail frame not found!!!"
    Exit Sub
313:   End If
314:   pSeriesProps.DataFrameName = pMap.Name
  
  'Find the layer
317:   Set pFeatLayer = FindLayer(cmbIndexLayer.Text, pMap)
318:   If pFeatLayer Is Nothing Then
319:     MsgBox "Index layer not found!!!"
    Exit Sub
321:   End If
322:   pSeriesProps.IndexLayerName = pFeatLayer.Name
323:   pSeriesProps.IndexFieldName = cmbIndexField.Text
    
  'Determine the tiles we are interested in
326:   Set pQuery = New QueryFilter
327:   sFieldName = cmbIndexField.Text
328:   pQuery.AddField sFieldName
'  pQuery.WhereClause = sFieldName & " <> ''"
330:   pQuery.WhereClause = sFieldName & " is not null"
331:   If optTiles(0).value Then
332:     Set pCursor = pFeatLayer.Search(pQuery, True)
333:     pSeriesProps.TileSelectionMethod = 0
334:   ElseIf optTiles(1).value Then
335:     Set pFeatLayerSel = pFeatLayer
336:     pFeatLayerSel.SelectionSet.Search pQuery, True, pCursor
337:     pSeriesProps.TileSelectionMethod = 1
338:   Else
339:     Set pActiveView = pMap
340:     Set pSpatialQuery = New SpatialFilter
341:     pSpatialQuery.AddField sFieldName
342:     pSpatialQuery.SpatialRel = esriSpatialRelIntersects
343:     Set pSpatialQuery.Geometry = pActiveView.Extent
344:     pSpatialQuery.WhereClause = sFieldName & " <> ''"
345:     pSpatialQuery.GeometryField = pFeatLayer.FeatureClass.shapeFieldName
346:     Set pCursor = pFeatLayer.Search(pSpatialQuery, True)
347:     pSeriesProps.TileSelectionMethod = 2
348:   End If
  
  'Add 2/18/04 to keep track of starting page number
351:   pSeriesProps.StartNumber = CLng(txtNumbering.Text)
  
  'Set the clip, label and rotate properties
  'Updated 6/18/03 to support cross hatch outside clip area
355:   If chkOptions(1).value = 1 Then
356:     If chkOptions(3).value = 1 Then
357:       pSeriesOpt2.ClipData = 2
358:     Else
359:       pSeriesOpt2.ClipData = 1
360:     End If
361:   Else
362:     pSeriesOpt2.ClipData = 0
363:   End If
'  If chkOptions(1).Value = 1 Then
'    pSeriesOpt.ClipData = True
'  Else
'    pSeriesOpt.ClipData = False
'  End If
  
370:   If chkOptions(0).value = 1 Then
371:     pSeriesOpt.RotateFrame = True
372:     pSeriesOpt.RotationField = cmbRotateField.Text
373:     lRotIndex = pFeatLayer.FeatureClass.FindField(cmbRotateField.Text)
374:   Else
375:     pSeriesOpt.RotateFrame = False
376:   End If
377:   If chkOptions(2).value = 1 Then
378:     pSeriesOpt.LabelNeighbors = True
379:   Else
380:     pSeriesOpt.LabelNeighbors = False
381:   End If
382:   Set pSeriesOpt.LabelSymbol = m_pTextSym
  
  'Set selection tile drawing property - Added 11/23/04
385:   If chkOptions(4).value = 1 Then
386:     pSeriesOpt3.SelectTile = True
387:   Else
388:     pSeriesOpt3.SelectTile = False
389:   End If
  
  'Set the extent properties
392:   If optExtent(0).value Then         'Variable
393:     pSeriesOpt.ExtentType = 0
394:     If txtMargin.Text = "" Then
395:       pSeriesOpt.Margin = 0
396:     Else
397:       pSeriesOpt.Margin = CDbl(txtMargin.Text)
398:     End If
399:     pSeriesOpt.MarginType = cmbMargin.ListIndex
400:   ElseIf optExtent(1).value Then    'Fixed
401:     pSeriesOpt.ExtentType = 1
402:     pSeriesOpt.FixedScale = txtFixed.Text
403:   Else                        'Data driven
404:     pSeriesOpt.ExtentType = 2
405:     pSeriesOpt.DataDrivenField = cmbDataDriven.Text
406:     lScaleIndex = pFeatLayer.FeatureClass.FindField(cmbDataDriven.Text)
407:   End If
  
  'Store suppression information
410:   If chkSuppress.value = 1 And lstSuppressTiles.SelCount > 0 Then
411:     pSeriesProps.SuppressLayers = True
412:     For lLoop = 0 To lstSuppressTiles.ListCount - 1
413:       If lstSuppressTiles.Selected(lLoop) Then
414:         pSeriesProps.AddLayerToSuppress lstSuppressTiles.List(lLoop)
415:       End If
416:     Next lLoop
417:   Else
418:     pSeriesProps.SuppressLayers = False
419:   End If
  
  'Create the pages and populate the treeview
422:   Set pTmpColl = New Collection
423:   lIndex = pFeatLayer.FeatureClass.FindField(sFieldName)
424:   Set pFeature = pCursor.NextFeature
425:   With g_pFrmMapSeries.tvwMapBook
426:     Set pNode = .Nodes.Add("MapBook", tvwChild, "MapSeries", "Map Series", 3)
427:     pNode.Tag = "MapSeries"
    
    'Add tile names to a listbox first for sort purposes
430:     g_pFrmMapSeries.lstSorter.Clear
431:     Do While Not pFeature Is Nothing
432:       sName = pFeature.value(lIndex)
433:       Set pTmpPage = New tmpPageClass
434:       pTmpPage.PageName = sName
435:       pTmpPage.PageRotation = 0
436:       pTmpPage.PageScale = 1
437:       Set pClone = pFeature.Shape
438:       Set pTmpPage.PageShape = pClone.Clone
      'Track the rotation and scale values (if we are going to use them) to the end
      'of the name, so we can assign them to the page when it is added without having
      'to query the index layer again.
442:       If chkOptions(0).value = 1 And lRotIndex >= 0 Then
443:         If Not IsNull(pFeature.value(lRotIndex)) Then
444:           pTmpPage.PageRotation = pFeature.value(lRotIndex)
445:         End If
446:       End If
447:       If optExtent(2).value And lScaleIndex >= 0 Then
448:         If Not IsNull(pFeature.value(lScaleIndex)) Then
449:           pTmpPage.PageScale = pFeature.value(lScaleIndex)
450:         End If
451:       End If
452:       If chkSuppress.value = 1 And lstSuppressTiles.SelCount > 0 Then
453:         If FeaturesInTile(pFeature, pMap) Then
454:           g_pFrmMapSeries.lstSorter.AddItem sName
455:           pTmpColl.Add pTmpPage, sName
456:         End If
457:       Else
458:         g_pFrmMapSeries.lstSorter.AddItem sName
459:         pTmpColl.Add pTmpPage, sName
460:       End If
461:       Set pFeature = pCursor.NextFeature
462:     Loop
    
    'Now loop back through the list and add the tile names as nodes in the tree
465:     For lLoop = 0 To g_pFrmMapSeries.lstSorter.ListCount - 1
466:       Set pMapPage = New DSMapPage
467:       lPageNumber = lLoop + CLng(txtNumbering.Text)
468:       sName = g_pFrmMapSeries.lstSorter.List(lLoop)
469:       Set pNode = .Nodes.Add("MapSeries", tvwChild, "a" & sName, lPageNumber & " - " & sName, 5)
470:       Set pTmpPage = pTmpColl.Item(sName)
471:       pNode.Tag = lLoop
472:       pMapPage.PageName = sName
473:       pMapPage.PageRotation = pTmpPage.PageRotation
474:       pMapPage.PageScale = pTmpPage.PageScale
475:       Set pMapPage.PageShape = pTmpPage.PageShape
476:       pMapPage.LastOutputted = #1/1/1900#
477:       pMapPage.EnablePage = True
478:       pMapPage.PageNumber = lPageNumber
479:       pMapSeries.AddPage pMapPage
480:     Next lLoop
481:     .Nodes.Item("MapBook").Expanded = True
482:     .Nodes.Item("MapSeries").Expanded = True
483:   End With
  
  'Add the series to the book
486:   pMapBook.AddContent pMapSeries

  Exit Sub
ErrHandler:
490:   MsgBox "CreateSeries - most likely you do not have unique names in your index layer!!!"
End Sub

Private Sub CheckForSelected()
On Error GoTo ErrHand:
  Dim pFeatSel As IFeatureSelection
  
  'Make sure there is something to check
498:   optTiles(1).Enabled = False
  If m_pIndexLayer Is Nothing Then Exit Sub
  
  'Check for selected features in the index layer
502:   Set pFeatSel = m_pIndexLayer
503:   If pFeatSel.SelectionSet.count <> 0 Then
504:     optTiles(1).Enabled = True
505:   End If

  Exit Sub
ErrHand:
509:   MsgBox "CheckForSelected - " & Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo ErrHand:
  Dim pDoc As IMxDocument, lLoop As Long
  'Get the extension
  If m_pApp Is Nothing Then Exit Sub
    
518:   m_bFormLoad = True
519:   Set m_pCurrentFrame = Nothing
520:   PositionFrame fraPage1
521:   cmdNext.Enabled = False
522:   cmdBack.Enabled = False
  
  'Initialize variables and controls
525:   m_iPage = 1
526:   chkOptions(0).value = 0
527:   chkOptions(1).value = 0
528:   chkOptions(2).value = 0
529:   chkOptions(4).value = 0
530:   chkSuppress.value = 0
531:   optTiles(0).value = True
532:   optExtent(0).value = True
533:   lstSuppressTiles.Enabled = False
534:   cmbRotateField.Enabled = False
535:   cmdLabelProps.Enabled = False
536:   chkOptions(3).Enabled = False
537:   txtNumbering.Text = "1"
  
  'Populate the data frame combo
540:   Set pDoc = m_pApp.Document
541:   cmbIndexField.Clear
542:   cmbDetailFrame.Clear
543:   For lLoop = 0 To pDoc.Maps.count - 1
544:     cmbDetailFrame.AddItem pDoc.Maps.Item(lLoop).Name
545:   Next lLoop
546:   cmbDetailFrame.ListIndex = 0
547:   m_bFormLoad = False
  
  'Populate the extent options
550:   cmbMargin.Clear
551:   cmbMargin.AddItem "percent"
552:   cmbMargin.AddItem "mapunits"
553:   cmbMargin.Text = "percent"
554:   txtMargin.Text = "0"
  
  'Set the initial Label symbol
557:   Set pDoc = m_pApp.Document
558:   Set m_pTextSym = New TextSymbol
559:   m_pTextSym.Font = pDoc.DefaultTextFont
560:   m_pTextSym.Size = pDoc.DefaultTextFontSize.Size
  
  'Make sure the wizard stays on top
563:   TopMost Me

  Exit Sub
  
ErrHand:
568:   MsgBox "frmMapSheetWiz Load - " & Err.Description
  Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
573:   Set m_pApp = Nothing
574:   Set m_pCurrentFrame = Nothing
575:   Set m_pMap = Nothing
576:   Set m_pIndexLayer = Nothing
End Sub

Private Sub optExtent_Click(Index As Integer)
On Error GoTo ErrHand:
  Select Case Index
  Case 0  'Variable
583:     txtMargin.Enabled = True
584:     cmbMargin.Enabled = True
585:     txtFixed.Enabled = False
586:     cmbDataDriven.Enabled = False
587:     If txtMargin.Text = "" Then
588:       cmdNext.Enabled = False
589:     Else
590:       cmdNext.Enabled = True
591:     End If
  Case 1  'Fixed
593:     txtMargin.Enabled = False
594:     cmbMargin.Enabled = False
595:     txtFixed.Enabled = True
596:     cmbDataDriven.Enabled = False
597:     If txtFixed.Text = "" Then
598:       cmdNext.Enabled = False
599:     Else
600:       cmdNext.Enabled = True
601:     End If
  Case 2  'Data driven
603:     txtMargin.Enabled = False
604:     cmbMargin.Enabled = False
605:     txtFixed.Enabled = False
606:     cmbDataDriven.Enabled = True
607:     cmdNext.Enabled = True
608:   End Select

  Exit Sub
ErrHand:
612:   MsgBox "optExtent_Click - " & Err.Description
End Sub

Private Sub txtFixed_KeyUp(KeyCode As Integer, Shift As Integer)
616:   If Not IsNumeric(txtFixed.Text) Then
617:     txtFixed.Text = ""
618:   End If
619:   If txtFixed.Text <> "" Then
620:     cmdNext.Enabled = True
621:   End If
End Sub

Private Sub txtMargin_KeyUp(KeyCode As Integer, Shift As Integer)
625:   If Not IsNumeric(txtMargin.Text) Then
626:     txtMargin.Text = ""
627:   End If
628:   If txtMargin.Text <> "" Then
629:     cmdNext.Enabled = True
630:   End If
End Sub

Private Function FeaturesInTile(pFeature As IFeature, pMap As IMap) As Boolean
'Routine for determining whether the specified tile feature (pFeature) should
'be suppressed.  Tiles are suppressed when there are no features from the checked
'layers in them.
On Error GoTo ErrHand:
  Dim lLoop As Long, pFeatLayer As IFeatureLayer, pSpatial As ISpatialFilter
  Dim pFeatCursor As IFeatureCursor, pSearchFeat As IFeature
  
641:   FeaturesInTile = False
  
643:   Set pSpatial = New SpatialFilter
644:   pSpatial.SpatialRel = esriSpatialRelIntersects
645:   Set pSpatial.Geometry = pFeature.Shape
646:   For lLoop = 0 To lstSuppressTiles.ListCount - 1
647:     If lstSuppressTiles.Selected(lLoop) Then
648:       Set pFeatLayer = FindLayer(lstSuppressTiles.List(lLoop), pMap)
649:       pSpatial.GeometryField = pFeatLayer.FeatureClass.shapeFieldName
650:       Set pFeatCursor = pFeatLayer.Search(pSpatial, True)
651:       Set pSearchFeat = pFeatCursor.NextFeature
652:       If Not pSearchFeat Is Nothing Then
653:         FeaturesInTile = True
        Exit Function
655:       End If
656:     End If
657:   Next lLoop

  Exit Function
  
ErrHand:
662:   MsgBox "FeaturesInTile - " & Err.Description
End Function

Private Sub txtNumbering_KeyUp(KeyCode As Integer, Shift As Integer)
666:   If Not IsNumeric(txtNumbering.Text) Then
667:     txtNumbering.Text = "1"
'  ElseIf CInt(txtNumbering.Text) < 0 Then
'    MsgBox "Can not use a number less than 0!!!"
'    txtNumbering.Text = "1"
671:   End If
End Sub