这个CADVBA一直跳出溢出报错,请大佬帮忙看下问题出在哪儿

2401_84398080 2025-03-18 13:43:44

Sub DrawCirclesOnBoundary()
    Dim boundary As AcadLWPolyline
    Dim vertices() As Double
    Dim minX As Double, maxX As Double
    Dim minY As Double, maxY As Double
    Dim i As Integer, j As Integer
    Dim gridSize As Double
    Dim radius As Double
    Dim centerX As Double, centerY As Double
    Dim centerPoint(0 To 2) As Double
    Dim numCellsX As Integer, numCellsY As Integer
    Dim adjustedGridSizeX As Double, adjustedGridSizeY As Double
    
    ' 设置网格大小和圆的半径
    gridSize = 24
    radius = 2
    
    ' 获取用户选择的多段线作为边界
    On Error Resume Next
    ThisDrawing.Utility.GetEntity boundary, Nothing, "请选择一条多段线作为边界: "
    On Error GoTo 0
    
    If boundary Is Nothing Then
        MsgBox "未选择多段线!"
        Exit Sub
    End If
    
    ' 提取多段线的顶点
    vertices = boundary.Coordinates
    
    ' 计算边界的最小包围矩形
    minX = vertices(0)
    maxX = vertices(0)
    minY = vertices(1)
    maxY = vertices(1)
    
    For i = 0 To UBound(vertices) Step 2
        If vertices(i) < minX Then minX = vertices(i)
        If vertices(i) > maxX Then maxX = vertices(i)
        If vertices(i + 1) < minY Then minY = vertices(i + 1)
        If vertices(i + 1) > maxY Then maxY = vertices(i + 1)
    Next i
    
    ' 计算网格数量
    numCellsX = Int((maxX - minX) / gridSize)
    numCellsY = Int((maxY - minY) / gridSize)
    
    ' 如果网格数量为0,则调整为1
    If numCellsX = 0 Then numCellsX = 1
    If numCellsY = 0 Then numCellsY = 1
    
    ' 调整网格大小,确保小于或等于24米,并且平均分布
    adjustedGridSizeX = (maxX - minX) / numCellsX
    adjustedGridSizeY = (maxY - minY) / numCellsY
    
    ' 确保网格大小不超过24米
    If adjustedGridSizeX > gridSize Then
        numCellsX = numCellsX + 1
        adjustedGridSizeX = (maxX - minX) / numCellsX
    End If
    If adjustedGridSizeY > gridSize Then
        numCellsY = numCellsY + 1
        adjustedGridSizeY = (maxY - minY) / numCellsY
    End If
    
    ' 在网格点上绘制圆圈(在多边形内或边界上)
    For i = 0 To numCellsX
        For j = 0 To numCellsY
            centerX = minX + i * adjustedGridSizeX
            centerY = minY + j * adjustedGridSizeY
            
            ' 检查点是否在边界内或边界上
            If IsPointInPolygon(centerX, centerY, vertices) Or IsPointOnPolygonBoundary(centerX, centerY, vertices) Then
                ' 设置圆心坐标
                centerPoint(0) = centerX
                centerPoint(1) = centerY
                centerPoint(2) = 0 ' Z 坐标设为 0
                
                ' 画圆
                ThisDrawing.ModelSpace.AddCircle centerPoint, radius
            End If
        Next j
    Next i
    
    ' 在多段线的角点上绘制圆圈
    For i = 0 To UBound(vertices) Step 2
        centerPoint(0) = vertices(i)
        centerPoint(1) = vertices(i + 1)
        centerPoint(2) = 0 ' Z 坐标设为 0
        ThisDrawing.ModelSpace.AddCircle centerPoint, radius
    Next i
    
    MsgBox "圆已绘制完成!"
End Sub

' 判断点是否在多边形内
Function IsPointInPolygon(x As Double, y As Double, vertices() As Double) As Boolean
    Dim i As Integer, j As Integer
    Dim n As Integer
    Dim inside As Boolean
    inside = False
    
    ' 计算多边形的顶点数量
    n = (UBound(vertices) + 1) / 2 ' 每个顶点有 X 和 Y 两个值
    
    For i = 0 To n - 1
        j = (i + 1) Mod n
        
        ' 获取当前边两个顶点的坐标
        Dim x1 As Double, y1 As Double
        Dim x2 As Double, y2 As Double
        x1 = vertices(i * 2)
        y1 = vertices(i * 2 + 1)
        x2 = vertices(j * 2)
        y2 = vertices(j * 2 + 1)
        
        ' 检查点是否在两个顶点之间
        If ((y1 > y) <> (y2 > y)) Then
            ' 计算交点
            Dim intersect As Double
            intersect = (x2 - x1) * (y - y1) / (y2 - y1) + x1
            
            ' 如果交点在点的右侧,则切换 inside 状态
            If x < intersect Then
                inside = Not inside
            End If
        End If
    Next i
    
    IsPointInPolygon = inside
End Function

' 判断点是否在多边形边界上
Function IsPointOnPolygonBoundary(x As Double, y As Double, vertices() As Double) As Boolean
    Dim i As Integer, j As Integer
    Dim n As Integer
    Dim onBoundary As Boolean
    onBoundary = False
    
    ' 计算多边形的顶点数量
    n = (UBound(vertices) + 1) / 2 ' 每个顶点有 X 和 Y 两个值
    
    For i = 0 To n - 1
        j = (i + 1) Mod n
        
        ' 获取当前边两个顶点的坐标
        Dim x1 As Double, y1 As Double
        Dim x2 As Double, y2 As Double
        x1 = vertices(i * 2)
        y1 = vertices(i * 2 + 1)
        x2 = vertices(j * 2)
        y2 = vertices(j * 2 + 1)
        
        ' 检查点是否在边界上
        If IsPointOnLine(x, y, x1, y1, x2, y2) Then
            onBoundary = True
            Exit For
        End If
    Next i
    
    IsPointOnPolygonBoundary = onBoundary
End Function

' 判断点是否在直线上
Function IsPointOnLine(x As Double, y As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Boolean
    Dim tolerance As Double
    tolerance = 0.0001 ' 容差值
    
    ' 计算点到直线的距离
    Dim distance As Double
    distance = Abs((y2 - y1) * x - (x2 - x1) * y + x2 * y1 - y2 * x1) / Sqr((y2 - y1) ^ 2 + (x2 - x1) ^ 2)
    
    ' 如果距离小于容差值,则认为点在直线上
    If distance < tolerance Then
        IsPointOnLine = True
    Else
        IsPointOnLine = False
    End If
End Function

 

 

这个CADVBA一直跳出溢出报错,请大佬帮忙看下问题出在哪儿

...全文
43 2 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
  • 打赏
  • 举报
回复

根本原因分析:

Integer类型溢出:

VBA中Integer类型范围为-32,768 ~ 32,767,当网格数量超过此范围时会导致溢出。

主要影响变量:numCellsX、numCellsY、循环计数器i、j

数组越界风险:

顶点坐标遍历时未校验数组长度,可能引发越界访问。

  • 举报
回复
@小仲老师 Sub DrawCirclesOnBoundary() Dim boundary As AcadLWPolyline Dim vertices() As Double Dim minX As Double, maxX As Double Dim minY As Double, maxY As Double Dim i As Long, j As Long ' 改为Long类型 Dim gridSize As Double Dim radius As Double Dim centerX As Double, centerY As Double Dim centerPoint(0 To 2) As Double Dim numCellsX As Long, numCellsY As Long ' 改为Long类型 Dim adjustedGridSizeX As Double, adjustedGridSizeY As Double ' 设置网格大小和圆的半径 gridSize = 24 radius = 2 ' 获取用户选择的多段线作为边界 On Error Resume Next ThisDrawing.Utility.GetEntity boundary, Nothing, "请选择一条多段线作为边界: " On Error GoTo 0 If boundary Is Nothing Then MsgBox "未选择多段线!" Exit Sub End If ' 提取多段线的顶点 vertices = boundary.Coordinates ' 计算边界的最小包围矩形 minX = vertices(0) maxX = vertices(0) minY = vertices(1) maxY = vertices(1) For i = 0 To UBound(vertices) Step 2 If vertices(i) &lt; minX Then minX = vertices(i) If vertices(i) &gt; maxX Then maxX = vertices(i) If vertices(i + 1) &lt; minY Then minY = vertices(i + 1) If vertices(i + 1) &gt; maxY Then maxY = vertices(i + 1) Next i ' 计算网格数量 numCellsX = Int((maxX - minX) / gridSize) numCellsY = Int((maxY - minY) / gridSize) ' 如果网格数量为0,则调整为1 If numCellsX = 0 Then numCellsX = 1 If numCellsY = 0 Then numCellsY = 1 ' 调整网格大小,确保小于或等于24米,并且平均分布 adjustedGridSizeX = (maxX - minX) / numCellsX adjustedGridSizeY = (maxY - minY) / numCellsY ' 确保网格大小不超过24米 If adjustedGridSizeX &gt; gridSize Then numCellsX = numCellsX + 1 adjustedGridSizeX = (maxX - minX) / numCellsX End If If adjustedGridSizeY &gt; gridSize Then numCellsY = numCellsY + 1 adjustedGridSizeY = (maxY - minY) / numCellsY End If ' 在网格点上绘制圆圈(在多边形内或边界上) For i = 0 To numCellsX For j = 0 To numCellsY centerX = minX + i * adjustedGridSizeX centerY = minY + j * adjustedGridSizeY ' 检查点是否在边界内或边界上 If IsPointInPolygon(centerX, centerY, vertices) Or IsPointOnPolygonBoundary(centerX, centerY, vertices) Then ' 设置圆心坐标 centerPoint(0) = centerX centerPoint(1) = centerY centerPoint(2) = 0 ' Z 坐标设为 0 ' 画圆 ThisDrawing.ModelSpace.AddCircle centerPoint, radius End If Next j Next i ' 在多段线的角点上绘制圆圈 For i = 0 To UBound(vertices) Step 2 centerPoint(0) = vertices(i) centerPoint(1) = vertices(i + 1) centerPoint(2) = 0 ' Z 坐标设为 0 ThisDrawing.ModelSpace.AddCircle centerPoint, radius Next i MsgBox "圆已绘制完成!" End Sub '... (其余函数保持原样,但确保所有循环变量使用Long)

2,503

社区成员

发帖
与我相关
我的任务
社区描述
VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧