vba里边有没有返回一个点坐标值的函数呀

97jr

我还是不太明白这些对象的用法，好像acadtext对象不能用在选择集里。那我如何表示选择集里被选中的文本，如何把acadtext对象加进去。请老师更具体的帮我解答一下。谢谢！！

mccad

Sub GetTxtIntPnt()
    ThisDrawing.Utility.Prompt vbCrLf & "本程序可显示所有选中文字(包括单行文字及多行文字)的坐标点"
    Dim sSet As AcadSelectionSet
    'On Error Resume Next
    Set sSet = CreateSelectionSet
    Dim fType As Variant, fData As Variant
    BuildFilter fType, fData, 0, "*text"
    sSet.SelectOnScreen fType, fData
    Dim entry As AcadEntity
    Dim Pnt As Variant
    ThisDrawing.Utility.Prompt vbCrLf & "以下为所有文本的坐标点："
    For Each entry In sSet
        Pnt = entry.InsertionPoint
    ThisDrawing.Utility.Prompt vbCrLf & Pnt(0) & ", " & Pnt(1) & ", " & Pnt(2)
    Next entry
    ThisDrawing.Utility.Prompt vbCrLf & "坐标点显示完毕，此程序由明经通道提供:http://www.mjtd.com"
    ThisDrawing.Utility.Prompt vbCrLf
End Sub


Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet



    Dim ss As AcadSelectionSet
   
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets(ssName)
    If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    ss.Clear
    Set CreateSelectionSet = ss


End Function

Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
    Dim fType() As Integer, fData()
    Dim index As Long, i As Long
   
    index = LBound(gCodes) - 1
        
    For i = LBound(gCodes) To UBound(gCodes) Step 2
        index = index + 1
        ReDim Preserve fType(0 To index)
        ReDim Preserve fData(0 To index)
        fType(index) = CInt(gCodes(i))
        fData(index) = gCodes(i + 1)
    Next
    typeArray = fType:    dataArray = fData
End Sub

mccad

97jr

非常感谢老师，请老师给推荐一些关于vba编程方面的书。可以了解更多的函数、对象、方法的。

mccad

不清楚就到这里来提问，提高的速度会更快些。
至于ACAD对象模型中的属性、事件及方法，倒是有一本书好点的，在明经商城中有介绍。