社区 › VBA/VB/ActiveX/API 编程技术 › vba里边有没有返回一个点坐标值的函数呀

97jr 发表于 2002-7-9 09:01:00

还是不行

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

mccad 发表于 2002-7-9 12:56:00

我把程序给写出来，你看看吧

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 发表于 2002-7-9 13:18:00

略做改动，就可以将坐标写到文本文件中了

97jr 发表于 2002-7-9 14:09:00

谢谢老师

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

mccad 发表于 2002-7-9 19:47:00

这方面的书还没有看到特别好的，都差不多，我网站上也有相关内容及函数

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

查看完整版本: vba里边有没有返回一个点坐标值的函数呀