2,503
社区成员




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一直跳出溢出报错,请大佬帮忙看下问题出在哪儿
根本原因分析:
Integer类型溢出:
VBA中Integer类型范围为-32,768 ~ 32,767,当网格数量超过此范围时会导致溢出。
主要影响变量:numCellsX、numCellsY、循环计数器i、j
数组越界风险:
顶点坐标遍历时未校验数组长度,可能引发越界访问。