analysis.frm

里面有我用VB二次开发MAPGIS的20个例子

Set r1 = New Rad
Set rBuf = New RadSet
For i = 1 To 10
r1.i = i '图元号
r1.r = i  '缓冲区半径
rBuf.Append r1
Next i
Set objRegArea = New RegArea '生成区工作区实例
useMode = gisVectMode   '光栅化/矢量化
rtl = objAnalysis.ListRegBuffer(objRegArea0, rBuf, objRegArea, useMode)
If rtl Then
    MsgBox "线缓冲区生成成功"
Else
    MsgBox "线缓冲区生成失败"
End If

Set r1 = Nothing
Set rBuf = Nothing
Set objRegArea0 = Nothing
Set objRegArea = Nothing
End Sub

Private Sub oneLinBuf_Click()

'...............求一条线BUFFER区......................

Dim objLinArea As LinArea
Dim li As Long
Dim objLinInfo As Lin_Info
Dim dime As Integer
Dim objDDotSet As D_DotSet
Dim rtl1 As Integer
Dim objDRect As D_Rect
Dim r As Double
Dim objRegArea As RegArea
Dim useMode As Enum_UseMode_Type
Dim knodFlg As Enum_KnobFlg_Type
Dim rtl As Boolean

Set objLinArea = New LinArea
li = 1
objLinArea.Load  '装入线文件
rtl1 = objLinArea.Get(li, objDDotSet, objLinInfo, dime) '取一条线
If rtl1 <> 1 Then Exit Sub

objLinArea.GetRect li, objDRect '取线范围
r = 10 '缓冲区半径
Set objRegArea = New RegArea '生成区工作区实例
useMode = gisVectMode   '光栅化/矢量化
knodFlg = gisRoundKnob  '圆头/方头
rtl = objAnalysis.OneLinBuffer(objDDotSet, objDRect, r, objRegArea, useMode, knodFlg)
If rtl Then
    MsgBox "线缓冲区生成成功"
Else
    MsgBox "线缓冲区生成失败"
End If

Set objLinArea = Nothing
Set objRegArea = Nothing

End Sub

Private Sub OnePntBuf_Click()
'...............求一个点BUFFER区......................

Dim objPntArea As PntArea
Dim pi As Long
Dim objPntInfo As Pnt_Info
Dim objDDot As D_Dot
Dim NoteDat As String
Dim rtl1 As Integer
Dim r As Double
Dim objRegArea As RegArea
Dim rtl As Boolean

Set objPntArea = New PntArea
pi = 1
objPntArea.Load '装入点文件
rtl1 = objPntArea.Get(pi, objDDot, NoteDat, objPntInfo) '取一个点
If rtl1 <> 1 Then Exit Sub

r = 10 '缓冲区半径
Set objRegArea = New RegArea '生成区工作区实例
rtl = objAnalysis.OnePntBuffer(objDDot, r, objRegArea)
If rtl Then
    MsgBox "线缓冲区生成成功"
Else
    MsgBox "线缓冲区生成失败"
End If

Set objPntArea = Nothing
Set objRegArea = Nothing


End Sub

Private Sub OneRegBuf_Click()
'...............求一个区BUFFER区......................

Dim objRegArea0 As RegArea
Dim ri As Long
Dim objLONGlist As LONGList
Dim objRegInfo As Reg_Info
Dim rtl1 As Integer
Dim r As Double
Dim objRegArea As RegArea
Dim useMode As Enum_UseMode_Type
Dim rtl As Boolean

Set objRegArea0 = New RegArea
Set objLONGlist = New LONGList
ri = 1
objRegArea0.Load '装入区文件
rtl1 = objRegArea0.Get(ri, objLONGlist, objRegInfo) '取一个区
If rtl1 <> 1 Then Exit Sub
r = 10 '缓冲区半径
Set objRegArea = New RegArea '生成区工作区实例
useMode = gisVectMode   '光栅化/矢量化
rtl = objAnalysis.OneRegBuffer(objRegArea0, ri, r, objRegArea, useMode)
If rtl Then
    MsgBox "线缓冲区生成成功"
Else
    MsgBox "线缓冲区生成失败"
End If

Set objLONGlist = Nothing
Set objRegArea0 = Nothing
Set objRegArea = Nothing

End Sub

Private Sub PntToLin_Click()
'...................点对线的叠加.........................
Dim objPntArea0 As PntArea
Dim objLinArea1 As LinArea
Dim objPntArea2 As PntArea
Dim radiu As Double
Dim op As Enum_Overlay_Type
Dim rtl As Boolean

Set objPntArea0 = New PntArea '叠加工作区对象
Set objLinArea1 = New LinArea '被叠加工作区对象
Set objPntArea2 = New PntArea '结果工作区对象
objPntArea0.Load '装入叠加工作区
objLinArea1.Load '装入被叠加工作区
radiu = 0.01 '模糊半径
op = gisOVLY_INTER '叠加类型-交
rtl = objAnalysis.OverlayPntLin(objPntArea0, objLinArea1, objPntArea2, radiu, op)

If rtl Then
    MsgBox "叠加成功"
Else
    MsgBox "叠加失败"
End If

Set objPntArea0 = Nothing
Set objLinArea1 = Nothing
Set objPntArea2 = Nothing
End Sub

Private Sub PntToReg_Click()

'...................点对区的叠加.........................
Dim objPntArea0 As PntArea
Dim objRegArea1 As RegArea
Dim objPntArea2 As PntArea
Dim radiu As Double
Dim op As Enum_Overlay_Type
Dim rtl As Boolean

Set objPntArea0 = New PntArea '叠加工作区对象
Set objRegArea1 = New RegArea '被叠加工作区对象
Set objPntArea2 = New PntArea '结果工作区对象
objPntArea0.Load '装入叠加工作区
objRegArea1.Load '装入被叠加工作区
radiu = 0.01 '模糊半径
op = gisOVLY_INTER '叠加类型-交
rtl = objAnalysis.OverlayPntReg(objPntArea0, objRegArea1, objPntArea2, radiu, op)

If rtl Then
    MsgBox "叠加成功"
Else
    MsgBox "叠加失败"
End If

Set objPntArea0 = Nothing
Set objRegArea1 = Nothing
Set objPntArea2 = Nothing
End Sub

Private Sub RegToPnt_Click()
'...................区对点的叠加.........................
Dim objRegArea0 As RegArea
Dim objPntArea1 As PntArea
Dim objRegArea2 As RegArea
Dim radiu As Double
Dim op As Enum_Overlay_Type
Dim rtl As Boolean

Set objRegArea0 = New RegArea '叠加工作区对象
Set objPntArea1 = New PntArea '被叠加工作区对象
Set objRegArea2 = New RegArea '结果工作区对象
objRegArea0.Load '装入叠加工作区
objPntArea1.Load '装入被叠加工作区
radiu = 0.01 '模糊半径
op = gisOVLY_INTER '叠加类型-交
rtl = objAnalysis.OverlayRegPnt(objRegArea0, objPntArea1, objRegArea2, radiu, op)

If rtl Then
    MsgBox "叠加成功"
Else
    MsgBox "叠加失败"
End If

Set objRegArea0 = Nothing
Set objPntArea1 = Nothing
Set objRegArea2 = Nothing
End Sub

Private Sub RegToReg_Click()
'...................区对区的叠加.........................
Dim objRegArea0 As RegArea
Dim objRegArea1 As RegArea
Dim objRegArea2 As RegArea
Dim radiu As Double
Dim op As Enum_Overlay_Type
Dim rtl As Boolean

Set objRegArea0 = New RegArea '叠加工作区对象
Set objRegArea1 = New RegArea '被叠加工作区对象
Set objRegArea2 = New RegArea '结果工作区对象
objRegArea0.Load '装入叠加工作区
objRegArea1.Load '装入被叠加工作区
radiu = 0.01 '模糊半径
op = gisOVLY_UNION '叠加类型-并
rtl = objAnalysis.OverlayRegReg(objRegArea0, objRegArea1, objRegArea2, radiu, op)

If rtl Then
    MsgBox "叠加成功"
Else
    MsgBox "叠加失败"
End If

Set objRegArea0 = Nothing
Set objRegArea1 = Nothing
Set objRegArea2 = Nothing

End Sub

Private Sub TolLinBuf_Click()
'...............求全部线BUFFER区......................

Dim objLinArea As LinArea
Dim r As Double
Dim objRegArea As RegArea
Dim useMode As Enum_UseMode_Type
Dim knodFlg As Enum_KnobFlg_Type
Dim rtl As Boolean

Set objLinArea = New LinArea
objLinArea.Load  '装入线文件
r = 10 '缓冲区半径
Set objRegArea = New RegArea '生成区工作区实例
useMode = gisVectMode   '光栅化/矢量化
knodFlg = gisRoundKnob  '圆头/方头
rtl = objAnalysis.TotalLinBuffer(objLinArea, r, objRegArea, useMode, knobflg)
If rtl Then
    MsgBox "线缓冲区生成成功"
Else
    MsgBox "线缓冲区生成失败"
End If

Set objLinArea = Nothing
Set objRegArea = Nothing

End Sub

Private Sub TolPntBuf_Click()
'...............求全部点BUFFER区......................

Dim objPntArea As PntArea
Dim r As Double
Dim objRegArea As RegArea
Dim useMode As Enum_UseMode_Type
Dim rtl As Boolean

Set objPntArea = New PntArea
objPntArea.Load  '装入点文件
r = 10 '缓冲区半径
Set objRegArea = New RegArea '生成区工作区实例
useMode = gisVectMode   '光栅化/矢量化
rtl = objAnalysis.TotalPntBuffer(objPntArea, r, objRegArea, useMode)
If rtl Then
    MsgBox "线缓冲区生成成功"
Else
    MsgBox "线缓冲区生成失败"
End If

Set objPntArea = Nothing
Set objRegArea = Nothing
End Sub

Private Sub TolRegBuf_Click()
'...............求全部区BUFFER区......................

Dim objRegArea0 As RegArea
Dim r As Double
Dim objRegArea As RegArea
Dim useMode As Enum_UseMode_Type
Dim rtl As Boolean

Set objRegArea0 = New RegArea
objRegArea0.Load  '装入区文件
r = 10 '缓冲区半径
Set objRegArea = New RegArea '生成区工作区实例
useMode = gisVectMode   '光栅化/矢量化
rtl = objAnalysis.TotalRegBuffer(objRegArea0, r, objRegArea, useMode)
If rtl Then
    MsgBox "线缓冲区生成成功"
Else
    MsgBox "线缓冲区生成失败"
End If

Set objRegArea0 = Nothing
Set objRegArea = Nothing
End Sub