'经纬度的十进制转换
unction zbzh(x As String) As String
Dim k As String
k = Int(x) + Int((x - Int(x)) * 100) / 60 + Int((x * 100 - Int(x * 100)) * 100) / 3600
zbzh = k
End Function
Private Sub UIButtonControl2_Click()
Dim ff As String
Dim ff1 As Double
Dim minx As Double
Dim miny As Double
Dim maxx As Double
Dim maxy As Double
minx = 116 + (0.5 / 3)
miny = 30.7
maxx = 122
maxy = 35.2
Dim xnum As Integer
Dim ynum As Integer
xnum = (maxx - minx) / (0.5 / 3)
ynum = (maxy - miny) / (0.5 / 3)
Dim pPDL As IPoint
Dim pPDR As IPoint
Dim pFeatcls As IFeatureClass
'纵
For i = 0 To xnum
Set pPDL = New Point
pPDL.PutCoords minx + i * 0.5 / 3, miny
Set pPDR = New Point
pPDR.PutCoords minx + i * 0.5 / 3, maxy
Call AddLineElementByTwoPoints(pPDL, pPDR, 1)
Next
'横
For i = 0 To ynum
Set pPDL = New Point
pPDL.PutCoords minx, miny + i * 0.5 / 3
Set pPDR = New Point
pPDR.PutCoords maxx, miny + i * 0.5 / 3
Call AddLineElementByTwoPoints(pPDL, pPDR, 1)
Next
End Sub
Private Sub AddLineElementByTwoPoints(pFromPoint As IPoint, pToPoint As IPoint, LineWidth As Integer)
'pFeatcls.CreateFeature
'
Dim pDoc As IMxDocument, pPageLayout As IPageLayout
Dim pContainer As IGraphicsContainer
Dim pTextElement As ITextElement
Set pDoc = ThisDocument
Dim pHline As IPolyline
Set pHline = New Polyline
pHline.FromPoint = pFromPoint
pHline.ToPoint = pToPoint
Dim pFeatcls As IFeatureClass
Dim flyr As IFeatureLayer
Set flyr = pDoc.FocusMap.Layer(0)
Set pFeatcls = flyr.FeatureClass
Dim pFeature As IFeature
Set pFeature = pFeatcls.CreateFeature
Set pFeature.Shape = pHline
pFeature.Store
End Sub