Rem 梁分XY方向
Sub BeamXY()
On Error Resume Next
Rem 创建图层
Dim BeamX_layer As AcadLayer
Set BeamX_layer = ThisDrawing.Layers.Add("梁平法标注_X方向")
BeamX_layer.color = acYellow
Dim BeamY_layer As AcadLayer
Set BeamY_layer = ThisDrawing.Layers.Add("梁平法标注_Y方向")
BeamY_layer.color = acWhite
Dim objSelected As Object
Dim acText As AcadText
Dim acLine As AcadLine
Rem 创建选择集
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets("XXX")
If Err Then
Set ssetObj = ThisDrawing.SelectionSets.Add("XXX")
ssetObj.Clear
End If
Rem 创建过滤器
Rem 同时选择 Text和Line
Dim FilterType(3) As Integer
Dim FilterData(3) As Variant
FilterType(0) = -4
FilterData(0) = "<or"
FilterType(1) = 0
FilterData(1) = "TEXT"
FilterType(2) = 0
FilterData(2) = "LINE"
FilterType(3) = -4
FilterData(3) = "or>"
Rem 在屏幕上选择
ssetObj.SelectOnScreen FilterType, FilterData
Rem 文字处理
Rem 对选择集中的文字对象BuildFilter fType, fData进行操作
For Each objSelected In ssetObj
If TypeOf objSelected Is AcadText Then
Set acText = objSelected
If acText.Layer = "梁原位标注" Or acText.Layer = "梁集中标注" Then
Dim A As Long
Rem 文字角度
A = Int(acText.Rotation * 360 / 3.1415926575 / 2)
Rem 角度调整至-90~270范围内
If A > 270 Then A = A - 360
Rem 角度在-45度~45度范围内归 梁平法标注_X方向 其他均归为 梁平法标注_Y方向
If A >= -45 And A <= 45 Then
acText.Layer = "梁平法标注_X方向"
Else
acText.Layer = "梁平法标注_Y方向"
End If
End If
End If
Next
Rem 直线处理
Rem 对选择集中的直线对象进行操作
For Each objSelected In ssetObj
If TypeOf objSelected Is AcadLine Then
Set acLine = objSelected
If acLine.Layer = "梁集中标注" Then
Rem 直线角度
A = Int(acLine.Angle * 360 / 3.1415926575 / 2)
Rem 角度调整至0~180范围内
If A > 180 Then A = Math.Abs(A - 360)
If A >= 45 And A <= 135 Then
acLine.Layer = "梁平法标注_X方向"
Else
acLine.Layer = "梁平法标注_Y方向"
End If
End If
End If
Next
End Sub
Sub BeamXY()
On Error Resume Next
Rem 创建图层
Dim BeamX_layer As AcadLayer
Set BeamX_layer = ThisDrawing.Layers.Add("梁平法标注_X方向")
BeamX_layer.color = acYellow
Dim BeamY_layer As AcadLayer
Set BeamY_layer = ThisDrawing.Layers.Add("梁平法标注_Y方向")
BeamY_layer.color = acWhite
Dim objSelected As Object
Dim acText As AcadText
Dim acLine As AcadLine
Rem 创建选择集
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets("XXX")
If Err Then
Set ssetObj = ThisDrawing.SelectionSets.Add("XXX")
ssetObj.Clear
End If
Rem 创建过滤器
Rem 同时选择 Text和Line
Dim FilterType(3) As Integer
Dim FilterData(3) As Variant
FilterType(0) = -4
FilterData(0) = "<or"
FilterType(1) = 0
FilterData(1) = "TEXT"
FilterType(2) = 0
FilterData(2) = "LINE"
FilterType(3) = -4
FilterData(3) = "or>"
Rem 在屏幕上选择
ssetObj.SelectOnScreen FilterType, FilterData
Rem 文字处理
Rem 对选择集中的文字对象BuildFilter fType, fData进行操作
For Each objSelected In ssetObj
If TypeOf objSelected Is AcadText Then
Set acText = objSelected
If acText.Layer = "梁原位标注" Or acText.Layer = "梁集中标注" Then
Dim A As Long
Rem 文字角度
A = Int(acText.Rotation * 360 / 3.1415926575 / 2)
Rem 角度调整至-90~270范围内
If A > 270 Then A = A - 360
Rem 角度在-45度~45度范围内归 梁平法标注_X方向 其他均归为 梁平法标注_Y方向
If A >= -45 And A <= 45 Then
acText.Layer = "梁平法标注_X方向"
Else
acText.Layer = "梁平法标注_Y方向"
End If
End If
End If
Next
Rem 直线处理
Rem 对选择集中的直线对象进行操作
For Each objSelected In ssetObj
If TypeOf objSelected Is AcadLine Then
Set acLine = objSelected
If acLine.Layer = "梁集中标注" Then
Rem 直线角度
A = Int(acLine.Angle * 360 / 3.1415926575 / 2)
Rem 角度调整至0~180范围内
If A > 180 Then A = Math.Abs(A - 360)
If A >= 45 And A <= 135 Then
acLine.Layer = "梁平法标注_X方向"
Else
acLine.Layer = "梁平法标注_Y方向"
End If
End If
End If
Next
End Sub
VBA 源文件
【BeamXY.rar】点击下载此文件
[本日志由 tiancao1001 于 2013-07-29 09:32 PM 编辑]
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |