(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
Přihlášení členové mohou přispívat, sledovat aktualizace a další. Jste tu noví? Zaregistrujte si bezplatný účet.
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.