Уважаемый a-d-k.
Вот ниже процедура на VBA. То что закомментировано, выдает мессагу с
площадью и периметром в кв.м и м, при условии, что фрейм данных имеет систему координат метрическую.
Public Sub GeoInfoFeature()
Set pMxDoc = ThisDocument
Dim pEnumFeat As IEnumFeature
Dim pSelFeat As IFeature
Dim curva As ICurve
dGlobalPerimetr = 0
dGlobalArea = 0
Set pEnumFeat = pMxDoc.FocusMap.FeatureSelection
If pMxDoc.FocusMap.SelectionCount <> 1 Then
MsgBox "Необходимо выбрать ОДИН участок!", vbInformation
Exit Sub
End If
Set pSelFeat = pEnumFeat.Next
If pSelFeat Is Nothing Then
MsgBox "Не выбран участок", vbCritical
Exit Sub
End If
If pSelFeat.Shape.GeometryType = esriGeometryPolygon Then
Dim pArea As IArea
Set pArea = pSelFeat.Shape
Set curva = pSelFeat.Shape
Dim a As Double
Dim l As Double
Dim b As String
Dim P As String
Dim strA As String
Dim strP As String
'l = curva.Length
'a = pArea.Area
'gectar = a / 10000
'b = Round(a, 1)
'b = FormatNumber(b, 1)
'P = Round(l, 2)
'P = FormatNumber(P, 2)
'strA = "Площадь " & b & " кв.м"
'strP = "Периметр " & P & " м"
'MsgBox strA & vbNewLine & strP, vbInformation
'AttribResultFrm.lblArea = strA
'AttribResultFrm.lblArea = strP
dGlobalArea = pArea.Area
dGlobalPerimetr = curva.Length
frmGeoInfo.UserForm_Initialize
frmGeoInfo.txtArea.text = CStr(FormatNumber(dGlobalArea, 2))
frmGeoInfo.txtPer.text = CStr(FormatNumber(dGlobalPerimetr, 2))
frmGeoInfo.Show
Else
'MsgBox "Выбранный объект не имеет площади", vbCritical
Set curva = pSelFeat.Shape
dGlobalPerimetr = curva.Length
frmGeoInfo.UserForm_Initialize
frmGeoInfo.txtArea.Enabled = False
frmGeoInfo.cmbPer.Enabled = False
frmGeoInfo.txtPer.text = CStr(FormatNumber(dGlobalPerimetr, 2))
ответил
17 Фев, 06
от
