Сработает ли такой код: (в слое только полилинии и контуры)
Private Sub Command3_Click()
Dim elem As Element
Dim elems As Elements
Dim k As Double
Dim Xcoord As Double
Dim Ycoord As Double
Dim oldElemID As Long
Dim newElemID As Long
Set elems = MapCtrl1.Map.Layers.Active.Elements
Set elem = elems.FirstItem
Do
If elem.GraphType = eGraphTypePrimSquare Then
k = elem.Contour.NumTops
Xcoord = 0
Ycoord = 0
For j = 1 To k
Xcoord = Xcoord + elem.Contour.GetX(j)
Ycoord = Ycoord + elem.Contour.GetY(j)
Next j
Xcoord = Xcoord / (k)
Ycoord = Ycoord / (k)
oldElemID = elem.key
DeleteElement(oldElemID)
newElemID = AddSimpleSymbol(Xcoord, Ycoord, 0, 1, 100, 1)
ChangeElemID(newElemID, oldElemID, FALSE)
Else
If elem.GraphType = eGraphTypePrimPolyline Then
k = elem.PolyLine.NumTops
Xcoord = 0
Ycoord = 0
For j = 1 To k
Xcoord = Xcoord + elem.PolyLine.GetX(j)
Ycoord = Ycoord + elem.PolyLine.GetY(j)
Next j
Xcoord = Xcoord / (k)
Ycoord = Ycoord / (k)
oldElemID = elem.key
DeleteElement(oldElemID)
newElemID = AddSimpleSymbol(Xcoord, Ycoord, 0, 1, 100, 1)
ChangeElemID(newElemID, oldElemID, FALSE)
End If
End If
Set elem = elems.NextItem
If elem.Key = -1 Then Exit Do
Loop
MsgBox "Преобразование закончено", vbInformation
End Sub
Код на основе примера про "Экспорт".
