如何使编号咬合圆心?
在cad中 每个圆都有一个文本编号在其旁边 但是此文本编号的对齐点不咬合圆心请问如何将这些编号逐一咬合到靠近它的圆的圆心上,谢谢 !!!如何使编号咬合圆心?
**** Hidden Message ***** 移过去,呵呵。想用程序来实现也行:如果圆的大小都一样的话可以这样来实现:选择模型空间的所有实体,筛选出指定大小的圆并提取圆心坐标,同时筛选出所有文本实体的插入点。构建循环,计算文本插入点和圆心之间的距离,将最小距离的文本实体移动到圆心上就可以了。
谢谢!
能不能写点示例代码看看啊? 可以,请你把示例文件传上来,根据你的文件具体来写。
示例文件已经给你发过去了 谢谢!
你的示例文件中的圆和文本规律不是很明显,程序实现起来做到完全准确比较困难。给你写了一段代码,你可按实际情况修改使用:
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, MinDisAs 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
好的谢谢!
页:
[1]