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

clement

如图所示，现在有很多类似的内容，需要将每个Circle内部两个text组合起来作为一个字符串的列表,比如右上角那个Circle中的内容是FY和4101B,最后希望得到FY-4101B.形式是完全一样的,谢谢!

zfbj

只实现其中的一个圆内文字？
还是要获得图中所有的文字内容？

clement

谢谢zfbj的答复
获得一个也行，循环就是了

clement

以下是我的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

syk070205

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