归并图层和字体样式
'归并图层
Sub GuiBingTuCeng()
Dim E As AcadEntity
Dim B As AcadBlock
For Each B In ThisDrawing.Blocks
For Each E In B
E.Layer = "0"
Next
Next
End Sub
'归并文字样式
Sub GuiBingTxtStyle()
Dim T As AcadText
Dim MT As AcadMText
Dim E As AcadEntity
Dim B As AcadBlock
For Each B In ThisDrawing.Blocks
For Each E In B
If E.ObjectName = "AcDbText" Then
Set T = E
T.StyleName = "Standard"
ElseIf E.ObjectName = "AcDbMText" Then
Set MT = E
MT.StyleName = "Standard"
End If
Next
Next
ThisDrawing.SendCommand "regen" & vbLf
End Sub
Sub GuiBingTuCeng()
Dim E As AcadEntity
Dim B As AcadBlock
For Each B In ThisDrawing.Blocks
For Each E In B
E.Layer = "0"
Next
Next
End Sub
'归并文字样式
Sub GuiBingTxtStyle()
Dim T As AcadText
Dim MT As AcadMText
Dim E As AcadEntity
Dim B As AcadBlock
For Each B In ThisDrawing.Blocks
For Each E In B
If E.ObjectName = "AcDbText" Then
Set T = E
T.StyleName = "Standard"
ElseIf E.ObjectName = "AcDbMText" Then
Set MT = E
MT.StyleName = "Standard"
End If
Next
Next
ThisDrawing.SendCommand "regen" & vbLf
End Sub
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |