如何使编号咬合圆心?
本帖最后由 作者 于 2009-1-18 16:22:58 编辑在cad中 每个圆都有一个文本编号在其旁边 但是此文本编号的对齐点不咬合圆心请问如何将这些编号逐一咬合到靠近它的圆的圆心上,谢谢 !!! <p>移过去,呵呵。想用程序来实现也行:如果圆的大小都一样的话可以这样来实现:选择模型空间的所有实体,筛选出指定大小的圆并提取圆心坐标,同时筛选出所有文本实体的插入点。构建循环,计算文本插入点和圆心之间的距离,将最小距离的文本实体移动到圆心上就可以了。</p><p></p> 谢谢!
能不能写点示例代码看看啊? <p>可以,请你把示例文件传上来,根据你的文件具体来写。</p> <p>示例文件已经给你发过去了 谢谢!</p> <p>你的示例文件中的圆和文本规律不是很明显,程序实现起来做到完全准确比较困难。给你写了一段代码,你可按实际情况修改使用:</p><p> Dim CssetObj As AcadSelectionSet<br/> Set CssetObj = ThisDrawing.SelectionSets.Add("CssetObj")<br/> <br/>'<br/> Dim Cgpcode(0) As Integer<br/> Dim Cdatavalue(0) As Variant<br/> Cgpcode(0) = 0<br/> Cdatavalue(0) = "CIRCLE"<br/> <br/> <br/> Dim Cgroupcode As Variant, Cdatacode As Variant<br/> Cgroupcode = Cgpcode<br/> Cdatacode = Cdatavalue<br/> CssetObj.Select acSelectionSetAll, , , Cgroupcode, Cdatacode<br/> <br/> Dim TssetObj As AcadSelectionSet<br/> Set TssetObj = ThisDrawing.SelectionSets.Add("TssetObj")<br/> <br/> Dim Tgpcode(0) As Integer<br/> Dim Tdatavalue(0) As Variant<br/> Tgpcode(0) = 0<br/> Tdatavalue(0) = "TEXT"</p><p> Dim Tgroupcode As Variant, Tdatacode As Variant<br/> Tgroupcode = Tgpcode<br/> Tdatacode = Tdatavalue<br/> TssetObj.Select acSelectionSetAll, , , Tgroupcode, Tdatacode<br/> <br/> <br/> Dim i As Integer<br/> Dim CENT, TENT As AcadEntity<br/> Dim Ccet, Tpoint As Variant<br/> Dim Distance, MinDis As Double<br/> MinDis = 1000000000<br/> <br/> For i = 0 To CssetObj.Count - 1<br/> Set CENT = CssetObj(i)<br/> Ccet = CENT.Center<br/> For j = 0 To TssetObj.Count - 1<br/> Set TENT = TssetObj(j)<br/> Tpoint = TENT.InsertionPoint<br/> Distance = Sqr((Tpoint(0) - Ccet(0)) * (Tpoint(0) - Ccet(0)) + (Tpoint(1) - Ccet(1)) * (Tpoint(1) - Ccet(1)))<br/> If MinDis > Distance Then<br/> MinDis = Distance<br/> End If<br/> Next j '<br/> <br/> For k = 0 To TssetObj.Count - 1<br/> Set TENT = TssetObj(k)<br/> Tpoint = TENT.InsertionPoint<br/> Distance = Sqr((Tpoint(0) - Ccet(0)) * (Tpoint(0) - Ccet(0)) + (Tpoint(1) - Ccet(1)) * (Tpoint(1) - Ccet(1)))<br/> If Distance = MinDis Then<br/> TENT.Alignment = acAlignmentMiddleCenter<br/> TENT.TextAlignmentPoint = Ccet<br/> TENT.Update<br/> End If<br/> Next k<br/> MinDis = 1000000000<br/> Next i<br/> <br/> CssetObj.Delete<br/> TssetObj.Delete</p> 好的谢谢!
页:
[1]