Option Explicit
' 创建众多数字的外接圆
Public Sub CreateCirclesToNumbers()
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.PickfirstSelectionSet
If SSet.Count = 0 Then
MsgBox "未选择对象"
Exit Sub
End If
Dim objText As AcadEntity
Dim ptMin As Variant, ptMax As Variant
Dim ptCenter(0 To 2) As Double
Dim radius As Double
For Each objText In SSet
If TypeName(objText) Like "IAcad*Text2" Then
If IsNumeric(objText.TextString) Then
' 获得文字的包围框
objText.GetBoundingBox ptMin, ptMax
全部回答（4 ）
-
tongmingniao
提供一种思路：
2009-03-15 23:29:15
来自 PC
评论
举报
-
施工cad
大于10或大小写字母,也很简单的啊,非常的简单.
2008-11-03 13:33:03
来自 PC
评论
举报
加载更多先写数字再画圈。
以下vba程序，须先选择对象。
Option Explicit
' 创建众多数字的外接圆
Public Sub CreateCirclesToNumbers()
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.PickfirstSelectionSet
If SSet.Count = 0 Then
MsgBox "未选择对象"
Exit Sub
End If
Dim objText As AcadEntity
Dim ptMin As Variant, ptMax As Variant
Dim ptCenter(0 To 2) As Double
Dim radius As Double
For Each objText In SSet
If TypeName(objText) Like "IAcad*Text2" Then
If IsNumeric(objText.TextString) Then
' 获得文字的包围框
objText.GetBoundingBox ptMin, ptMax
' 获得圆心和半径
ptCenter(0) = (ptMin(0) + ptMax(0)) / 2
ptCenter(1) = (ptMin(1) + ptMax(1)) / 2
ptCenter(2) = 0
radius = Sqr((ptMin(0) - ptMax(0)) ^ 2 + (ptMin(1) - ptMax(1)) ^ 2) / 2
' 创建圆
ThisDrawing.ModelSpace.AddCircle ptCenter, radius
End If
End If
Next
ThisDrawing.Regen True
End Sub
用这个免费的程序,连续编号啊
《钢构CAD2.6》点击以下网址即可打开下载：
《新浪网》操作简单速度快，下载时请留言：
http://down1.tech.sina.com.cn/download/down_contents/1220112000/40544.shtml
《华军软件园》：
http://www.onlinedown.net/soft/76074.htm
《中国下载站》：
http://download.china.com/soft/8659.shtml
《绿色软件联盟》：
http://www.xdowns.com/soft/31/221/2008/Soft_43421.html
《钢构CAD网盘》：
http://www.bibidu.com/user/ggcad28.html