|
|
Public Sub CreateCircleToText()
Dim objText As AcadText
Dim ptPick As Variant
ThisDrawing.Utility.GetEntity objText, ptPick, "拾取文字:"
' 获得文字的包围框
Dim ptMin As Variant, ptMax As Variant
objText.GetBoundingBox ptMin, ptMax
' 获得圆心和半径
Dim ptCenter(0 To 2) As Double
ptCenter(0) = (ptMin(0) + ptMax(0)) / 2
ptCenter(1) = (ptMin(1) + ptMax(1)) / 2
ptCenter(2) = 0
Dim radius As Double
radius = Sqr((ptMin(0) - ptMax(0)) ^ 2 + (ptMin(1) - ptMax(1)) ^ 2) / 2
' 创建圆
Dim objCircle As AcadCircle
Set objCircle = ThisDrawing.ModelSpace.AddCircle(ptCenter, radius)
End Sub
最后运行结果是弹出一个ＭＳＧＢＯＸ，提示＂类型不匹配"
|
|
置顶卡
