|
|
发表于 2009-1-19 12:20:00
|
显示全部楼层
你的示例文件中的圆和文本规律不是很明显，程序实现起来做到完全准确比较困难。给你写了一段代码，你可按实际情况修改使用：
Dim CssetObj As AcadSelectionSet
Set CssetObj = ThisDrawing.SelectionSets.Add("CssetObj")
'
Dim Cgpcode(0) As Integer
Dim Cdatavalue(0) As Variant
Cgpcode(0) = 0
Cdatavalue(0) = "CIRCLE"
Dim Cgroupcode As Variant, Cdatacode As Variant
Cgroupcode = Cgpcode
Cdatacode = Cdatavalue
CssetObj.Select acSelectionSetAll, , , Cgroupcode, Cdatacode
Dim TssetObj As AcadSelectionSet
Set TssetObj = ThisDrawing.SelectionSets.Add("TssetObj")
Dim Tgpcode(0) As Integer
Dim Tdatavalue(0) As Variant
Tgpcode(0) = 0
Tdatavalue(0) = "TEXT"
Dim Tgroupcode As Variant, Tdatacode As Variant
Tgroupcode = Tgpcode
Tdatacode = Tdatavalue
TssetObj.Select acSelectionSetAll, , , Tgroupcode, Tdatacode
Dim i As Integer
Dim CENT, TENT As AcadEntity
Dim Ccet, Tpoint As Variant
Dim Distance, MinDis As Double
MinDis = 1000000000
For i = 0 To CssetObj.Count - 1
Set CENT = CssetObj(i)
Ccet = CENT.Center
For j = 0 To TssetObj.Count - 1
Set TENT = TssetObj(j)
Tpoint = TENT.InsertionPoint
Distance = Sqr((Tpoint(0) - Ccet(0)) * (Tpoint(0) - Ccet(0)) + (Tpoint(1) - Ccet(1)) * (Tpoint(1) - Ccet(1)))
If MinDis > Distance Then
MinDis = Distance
End If
Next j '
For k = 0 To TssetObj.Count - 1
Set TENT = TssetObj(k)
Tpoint = TENT.InsertionPoint
Distance = Sqr((Tpoint(0) - Ccet(0)) * (Tpoint(0) - Ccet(0)) + (Tpoint(1) - Ccet(1)) * (Tpoint(1) - Ccet(1)))
If Distance = MinDis Then
TENT.Alignment = acAlignmentMiddleCenter
TENT.TextAlignmentPoint = Ccet
TENT.Update
End If
Next k
MinDis = 1000000000
Next i
CssetObj.Delete
TssetObj.Delete
|
|
置顶卡
