这个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一直跳出溢出报错,请大佬帮忙看下问题出在哪儿

...全文
452 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
小仲老师 2025-04-02
  • 打赏
  • 举报
回复

根本原因分析:

Integer类型溢出:

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

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

数组越界风险:

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

小仲老师 2025-04-02
  • 举报
回复
@小仲老师 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)
内容概要:本文围绕基于三重移相控制(TPS)的双有源桥(DAB)高频隔离DC-DC变换器开展系统性研究,重点构建了其在Simulink环境下的高精度仿真模型。研究全面涵盖SPS单相移相、DPS双重重移相与TPS三重移相等多种控制策略的建模、实现与性能对比,深入分析不同模式下变换器的功率传输特性、软开关实现条件及功率回流问题,旨在提升DAB在交直流混合微电网、能量路由器、多端口柔性互联装置等场景中的转换效率与动态响应能力。通过对ZVS(零电压切换)条件的精确控制与移相角参数的优化,有效降低了开关损耗,增强了系统整体能效与运行稳定性。该仿真模型具有良好的可扩展性,适用于复杂电能转换系统的科研验证与工程开发。; 适合人群:电力电子、电气工程及其自动化等相关专业的硕士研究生、博士生、科研人员以及从事新能源变换器、柔性输配电系统设计的工程技术人员。; 使用场景及目标:①掌握双有源桥DAB变换器的基本工作原理及其在高频隔离场合的核心优势;②深入理解三重移相控制策略的设计机理、控制自由度分配及其在效率优化中的关键作用;③构建并调试可用于科研论文撰写、项目申报或实际系统验证的高保真Simulink仿真模型,支撑理论分析与实验对比。; 阅读建议:建议结合MATLAB/Simulink平台进行动手实践,重点关注主电路拓扑搭建、移相控制模块设计、驱动信号时序配置及ZVS实现条件的仿真观测,推荐通过对比SPS、DPS与TPS三种模式的稳态与动态响应曲线,深入掌握各控制策略的适用边界与优化方向。
【重要提示】本资源设置为0积分下载,若非0积分勿轻易下载 亲爱的CSDN用户: 首先感谢你点进这个资源页面。我需要提前说明一个重要情况: 本资源原本已设置为“0积分下载”,即作者希望完全免费共享。但CSDN平台有时会根据文件的下载热度、文件大小、用户权限等因素,自动将部分资源的积分调整为非0数值(如1积分、2积分、5积分等)。这是平台系统的自动行为,而非作者本人的设定。 因此,如果你当前看到该资源的下载所需积分不是0(例如显示为1、2、3……),谨慎决定是否下载。 如果你按照非0积分支付并下载后发现资源内容不符合预期、链接失效,或者实际上该资源本应是免费的,作者无法为此承担积分损失或退还操作。强烈建议:仅在页面显示为0积分时进行下载。 另外,本资源描述中并未直接提供具体的下载地址或外部链接,因为它本身是一个通过CSDN官方上传通道提交的文件/内容包。如果你看到描述中没有外部网盘地址,这是正常的——资源文件应通过CSDN内置的“下载”按钮获取。若因平台积分显示异常导致你支付了积分,优先联系CSDN客服咨询积分退还政策,作者没有权限修改平台自动设定的积分值。 感谢你的理解与支持。技术分享本应开放,但受限于平台规则,特此提醒如上。祝学习进步!

2,506

社区成员

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

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