明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3067|回复: 4

请赐教:如何用VBA获得圆圈内的文字

[复制链接]
发表于 2003-8-15 12:45 | 显示全部楼层 |阅读模式
如图所示,现在有很多类似的内容,需要将每个Circle内部两个text组合起来作为一个字符串的列表,比如右上角那个Circle中的内容是FY和4101B,最后希望得到FY-4101B.形式是完全一样的,谢谢!

本帖子中包含更多资源

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

x
发表于 2003-8-16 09:14 | 显示全部楼层
只实现其中的一个圆内文字?
还是要获得图中所有的文字内容?
 楼主| 发表于 2003-8-16 10:22 | 显示全部楼层
谢谢zfbj的答复
获得一个也行,循环就是了
 楼主| 发表于 2003-8-26 20:55 | 显示全部楼层
以下是我的code,欢迎提宝贵意见
Function test()
Dim myss As AcadSelectionSet
Dim itm As AcadEntity
Dim itm1 As AcadEntity
Dim mode As Integer
Dim r As Double
Dim pnt As Variant
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
Dim strtmp As String
Dim strpart1 As String
Dim strpart2 As String
Dim n As Integer
   
    mode = acSelectionSetCrossing
    n = 0
    For Each itm In ThisDrawing.ModelSpace
        If itm.ObjectName = "AcDbCircle" Then
            pnt = itm.Center
            Set myss = ThisDrawing.SelectionSets.Add("MYSS")
            r = itm.Radius
            corner1(0) = pnt(0) - 0.6 * r
            corner1(1) = pnt(1) + 0.6 * r
            corner1(2) = 0
            
            corner2(0) = pnt(0) + 0.6 * r
            corner2(1) = pnt(1) - 0.6 * r
            corner2(2) = 0
            
            ThisDrawing.SendCommand "Zoom "
            ThisDrawing.SendCommand corner1(0) & "," & corner1(1) & " "
            ThisDrawing.SendCommand corner2(0) & "," & corner2(1) & " "
   
            myss.Select mode, corner1, corner2
            
            If itm.Radius = 6 Then
               
                strtmp = vbNullString
                strpart1 = strtmp
                strpart2 = strtmp
                For Each itm1 In myss
                    If itm.Radius = 6 And itm1.ObjectName = "AcDbText" Then
                        strtmp = itm1.TextString
                        If Val(strtmp) > 0 Then
                            strpart2 = strtmp
                        Else
                            strpart1 = strtmp
                        End If
                    End If
                Next
                myss.Highlight True
                If strtmp <> vbNullString Then
                    n = n + 1
                    Debug.Print n, itm.Radius, Int(pnt(0)), Int(pnt(1)), strpart1 & "-" & strpart2
                End If
            End If
        
            myss.Clear
            myss.Delete
        End If
    Next
   
    ThisDrawing.SendCommand "Zoom "
    ThisDrawing.SendCommand "All "
End Function

评分

参与人数 1金钱 +2 贡献 +1 激情 +2 收起 理由
zfbj + 2 + 1 + 2 【好评】奖励发布解决问题的方法

查看全部评分

发表于 2010-8-7 16:44 | 显示全部楼层

没有楼主编的那么多,你可以直接参考<<AutoCAD VBA二次开发教程>>,上面有具体的编程思想和代码!

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 23:05 , Processed in 0.203693 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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