(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
Angemeldete Mitglieder können Beiträge verfassen, Updates folgen und mehr. Neu hier? Registriere ein kostenloses Konto.
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.