明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1350|回复: 6

如何使编号咬合圆心?

[复制链接]
发表于 2009-1-12 11:01:00 | 显示全部楼层 |阅读模式
本帖最后由 作者 于 2009-1-18 16:22:58 编辑

在cad中 每个圆都有一个文本编号在其旁边 但是此文本编号的对齐点不咬合圆心  请问如何将这些编号逐一咬合到靠近它的圆的圆心上,谢谢 !!!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2009-1-14 20:09:00 | 显示全部楼层

移过去,呵呵。想用程序来实现也行:如果圆的大小都一样的话可以这样来实现:选择模型空间的所有实体,筛选出指定大小的圆并提取圆心坐标,同时筛选出所有文本实体的插入点。构建循环,计算文本插入点和圆心之间的距离,将最小距离的文本实体移动到圆心上就可以了。

 楼主| 发表于 2009-1-17 08:25:00 | 显示全部楼层
谢谢!
能不能写点示例代码看看啊?
发表于 2009-1-17 08:52:00 | 显示全部楼层

可以,请你把示例文件传上来,根据你的文件具体来写。

 楼主| 发表于 2009-1-18 16:24:00 | 显示全部楼层

示例文件已经给你发过去了 谢谢!

发表于 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

 楼主| 发表于 2009-1-20 08:44:00 | 显示全部楼层
好的  谢谢!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 05:46 , Processed in 0.166108 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表