zoukankan      html  css  js  c++  java
  • vba buffer rectangle 矩形外边框

    Private Sub CommandButton1_Click()

    bufferrectangle

    End Sub

    Sub bufferrectangle()

    Dim pMxDoc As IMxDocument
    Set pMxDoc = Application.Document

    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap

    Dim pActiveView As IActiveView
    Set pActiveView = pMxDoc.FocusMap

    Dim pFeatureClassOne As IFeatureClass
    Dim pFLayerOne As IFeatureLayer

    Dim pFeatureClassTwo As IFeatureClass
    Dim pFLayerTwo As IFeatureLayer

    Dim pFeatureClassNew As IFeatureClass
    Dim pFLayerNew As IFeatureLayer

    Set pFLayerOne = pMap.Layer(0)


    Set pFeatureClassOne = pFLayerOne.FeatureClass


    Dim pFeatureCursorOne As IFeatureCursor


    Set pFeatureCursorOne = pFeatureClassOne.Search(Nothing, True)



    Dim pFeatureOne As IFeature


    Set pFeatureOne = pFeatureCursorOne.NextFeature

    Dim xmax As Double
    Dim ymax As Double
    Dim xmin As Double
    Dim ymin As Double



    Dim pPolygonOne As IPolygon
    Dim pPolygonNew As IPolygon

    Dim pOnePoints As IPointCollection
    Dim pNewPoints As IPointCollection
    Dim i As Integer
    Dim count As Integer
    count = 0

    Dim pNewPoint As IPoint
    Dim distance As Double
    distance = CDbl(TextBox1.Text)

     
    While Not pFeatureOne Is Nothing
       
       Set pPolygonOne = pFeatureOne.Shape
       Set pOnePoints = pPolygonOne
     
       For i = 0 To pOnePoints.PointCount - 1
     
       xmax = findxmax(pOnePoints)
       ymax = findymax(pOnePoints)
       xmin = findxmin(pOnePoints)
       ymin = findymin(pOnePoints)
       
       Set pNewPoints = New Polygon
       
       Set pNewPoint = New Point
       pNewPoint.X = xmin - distance
       pNewPoint.Y = ymax + distance
       pNewPoints.AddPoint pNewPoint
       
        Set pNewPoint = New Point
       pNewPoint.X = xmax + distance
       pNewPoint.Y = ymax + distance
       pNewPoints.AddPoint pNewPoint
       
       Set pNewPoint = New Point
       pNewPoint.X = xmax + distance
       pNewPoint.Y = ymin - distance
       pNewPoints.AddPoint pNewPoint

       Set pNewPoint = New Point
       pNewPoint.X = xmin - distance
       pNewPoint.Y = ymin - distance
       pNewPoints.AddPoint pNewPoint

       Next i
       
       Set pPolygonNew = pNewPoints
       pPolygonNew.Close
       
       Set pFeatureOne.Shape = pPolygonNew
       pFeatureOne.Store
       
     
       Set pFeatureOne = pFeatureCursorOne.NextFeature
       
       count = count + 1
       
       Label3.Caption = Str(count) & "个feature"
       
       UserForm1.Repaint
       

    Wend

    MsgBox "done!"

    End Sub


    Public Function findxmax(points As IPointCollection) As Double

    Dim xmax As Double
    Dim ppoint As IPoint
    Dim i As Integer

    Set ppoint = points.Point(0)
    xmax = ppoint.X

    For i = 1 To points.PointCount - 1

    Set ppoint = points.Point(i)

        If xmax < ppoint.X Then
        
        xmax = ppoint.X
        
        End If

    Next i

    findxmax = xmax

    End Function



    Public Function findymax(points As IPointCollection) As Double

    Dim ymax As Double
    Dim ppoint As IPoint
    Dim i As Integer

    Set ppoint = points.Point(0)
    ymax = ppoint.Y

    For i = 1 To points.PointCount - 1

    Set ppoint = points.Point(i)

        If ymax < ppoint.Y Then
        
        ymax = ppoint.Y
        
        End If

    Next i

    findymax = ymax

    End Function


    Public Function findxmin(points As IPointCollection) As Double

    Dim xmin As Double
    Dim ppoint As IPoint
    Dim i As Integer

    Set ppoint = points.Point(0)
    xmin = ppoint.X

    For i = 1 To points.PointCount - 1

    Set ppoint = points.Point(i)

        If xmin > ppoint.X Then
        
        xmin = ppoint.X
        
        End If

    Next i

    findxmin = xmin

    End Function

    Public Function findymin(points As IPointCollection) As Double

    Dim ymin As Double
    Dim ppoint As IPoint
    Dim i As Integer

    Set ppoint = points.Point(0)
    ymin = ppoint.Y

    For i = 1 To points.PointCount - 1

    Set ppoint = points.Point(i)

        If ymin > ppoint.Y Then
        
        ymin = ppoint.Y
        
        End If

    Next i

    findymin = ymin

    End Function

  • 相关阅读:
    20201019 day39 复习10:数据结构之树状数组、线段树
    20201019 day39 模拟(十二)&&复习9:贪心综合练习(一)
    静态路由的简易配置
    动态路由RIP的简易配置
    STP实验(指定特定交换机为根桥)
    结合以太通道的VLAN配置
    跨交换机划分VLAN配置及VTP管理交换机的VLAN配置
    单交换机划分VLAN配置
    linux常用命令集(文件系统权限操作-共5个)
    linux常用命令集(系统管理操作-共25个)
  • 原文地址:https://www.cnblogs.com/zhangjun1130/p/1874845.html
Copyright © 2011-2022 走看看