Select to view content in your preferred language

Edit Annotation Tool - Menu Options - Getting at Convert to Multi/Single Part tool

2272
1
02-05-2011 11:35 AM
DavidPlume1
Occasional Contributor
Hi Everyone,

I'd like to create some short cuts to point at the Convert to Multi/Single part commands on the Edit Annotation Tool.  These commands are available in the Advanced Editing Commands list but become inactive when posted on toolbars.

It would be very handy to associate some keys or similar short cuts to these commands while in an edit session.  I thought that the code to get to these properties would be pretty "easy" to wire up in VBA or a .NET addin. 

I've not even been able to find the interface these properties sit on.  Can anyone offer some insights into which objects manage Annotation Properties at this level?

Thanks
David
0 Kudos
1 Reply
DavidPlume1
Occasional Contributor
OK I've worked out what object(s) manage(s) single/multi part settings. 

This doesn't explain why the interface disables the basic command when posted on a toolbar but does give you a way to add this functionality to your own controls.

You derive IMultiPartTextElement from IElement:

(Please forgive the ragged bits in the following development code)

Private Sub ToggleSingleMulti()

On Error GoTo lblError

    Dim pDoc As IMxDocument
    Set pDoc = ThisDocument
    
    Dim pMap As IMap
    
    Set pMap = pDoc.FocusMap
    Dim pFeatSel As IEnumFeature
    Set pFeatSel = pMap.FeatureSelection
    
    Dim pFeat As IFeature
    Set pFeat = pFeatSel.Next
    
    Dim pAnnoFeat As IAnnotationFeature2
    Dim pElem As IElement
    Dim pTextEl As ITextElement
    Dim pMultTextEl As IMultiPartTextElement
    
    Dim pAnnoClassExt As IAnnotationClassExtension2
    Set pAnnoClassExt = GetAnnoFeaClsExt(pMap, pDoc)
    
    If pAnnoClassExt Is Nothing Then
              Exit Sub
    End If
    
    Do While Not pFeat Is Nothing
    
        If TypeOf pFeat Is IAnnotationFeature2 Then
                   
            Set pAnnoFeat = pFeat
            Set pElem = pAnnoFeat.Annotation
            
            If Not pElem Is Nothing Then
            
                Set pMultTextEl = pElem

                If pMultTextEl.IsMultipart Then
                    pMultTextEl.ConvertToSinglePart
                Else
                    pMultTextEl.ConvertToMultiPart pAnnoClassExt.Display(pElem)
                End If
                
                pAnnoFeat.Annotation = pElem
                Set pFeat = pAnnoFeat
                
                pFeat.Store
                
            End If

            
            
        End If
        
        Set pFeat = pFeatSel.Next
    
    
    Loop
    
    
    Exit Sub

lblError:

    Debug.Print Err.Description
    Exit Sub
    
End Sub

Public Function GetAnnoFeaClsExt(pMap As IMap, pMxdoc As IMxDocument) As IAnnotationClassExtension
  
  On Error GoTo lblError
  
  'Dim pMxDoc As IMxDocument
  'Set pMxDoc = Nothing
  
   
  Dim pID As UID  'Get a handle to the Editor extension
  Set pID = New UID
  
  Dim pAnnoExt As IAnnotationEditExtension
  
  Dim pAnnoID As New UID
  pAnnoID = "esriEditor.AnnotationEditExtension"
  
  Dim pAnnoClass As IAnnotationClassExtension

  pID = "esriEditor.Editor"
  
  Dim pEditor As IEditor2
  Set pEditor = Application.FindExtensionByCLSID(pID)
  
  Dim pEditLayers As IEditLayers
   
  
  If pEditor.EditState = esriStateNotEditing Then
    
    MsgBox "Please start the Editor to select points."
    
    Set GetAnnoFeaClsExt = Nothing
    Exit Function
    
  End If
  
  Set pEditLayers = pEditor 'QI to grab CurrentLayer property
  
   If pEditLayers Is Nothing Then
    
       return nothing

   End If
   
 Dim iLayerCount As Integer
 Dim pFeatureLayer As IFeatureLayer
 
 For iLayerCount = 0 To pMap.LayerCount - 1
 
    If TypeOf pMap.Layer(iLayerCount) Is IFeatureLayer Then
    
    
        Set pFeatureLayer = pMap.Layer(iLayerCount)
        s = pFeatureLayer.Name
        
        pEditLayers.SetCurrentLayer pFeatureLayer, 0
        
        Debug.Print pEditLayers.CurrentLayer.Name
    
    End If
    
    
 Next iLayerCount
 

  
    Set pAnnoClass = pEditLayers.CurrentLayer.FeatureClass.Extension
    Set GetAnnoFeaClsExt = pAnnoClass

    Exit Function

lblError:

    Debug.Print Err.Description
    Exit Function
    
End Function
0 Kudos