社区 › VBA/VB/ActiveX/API 编程技术 › 请帮忙吧，如何得到过滤选择集中的对象的属性呀！

rockes 发表于 2002-9-28 18:54:00

请帮忙吧，如何得到过滤选择集中的对象的属性呀！

如题。我做了一个直线的过滤的选择集，我需要了解直线的开始点以及终端点的坐标。我该如和做了。我首先定义了一个
   Dim sset As AcadSelectionSet
   dim Lline as acadline
set lline=sset.item(i)
可是就是不行呀我该如何？！

mccad 发表于 2002-9-28 20:29:00

一点问题都没有，请看以下提供的整个过程的例程

Sub GetLinePnt()
    Dim ss As AcadSelectionSet
    Set ss = CreateSelectionSet()
    Dim fType As Variant
    Dim fData As Variant
    BuildFilter fType, fData, 0, "Line"
    ss.SelectOnScreen fType, fData
    Dim Lline As AcadLine
    Dim I As Integer
   
    Dim StarPnt As Variant
    Dim EndPnt As Variant
    Dim DispInfo As String
    For I = 0 To ss.Count - 1
      Set Lline = ss.Item(I)
      StarPnt = Lline.StartPoint
      EndPnt = Lline.EndPoint
      DispInfo = DispInfo & "第" & I + 1 & "根线的起点坐标：" & PTos(StarPnt) & " 终点坐标：" & PTos(EndPnt) & vbCrLf
    Next
      MsgBox DispInfo, , "明经通道制作例程 http://www.mjtd.com "
End Sub

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

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

Private Function PTos(P As Variant) As String
    Dim S As String
    Dim pp(2) As Double
    pp(0) = P(0)
    pp(1) = P(1)
    S = RTOS(pp(0)) & ", " & RTOS(pp(1))
    If UBound(P) > 1 Then
       pp(2) = P(2)
      S = S & ", " & RTOS(pp(2))
    End If
    PTos = S
End Function

Private Function RTOS(Real As Double) As String
RTOS = ThisDrawing.Utility.RealToString(Real, acDefaultUnits, LuPrec)
End Function

rockes 发表于 2002-9-30 10:08:00

谢谢老大！

真太感谢老大了。呵呵

sdxylijian 发表于 2003-3-22 16:27:00

版主，能帮忙将以上代码转到vb中吗？

版主，能帮忙将以上代码转到vb中吗？

qiush1234 发表于 2015-10-12 15:20:09

mccad 发表于 2002-9-28 20:29 static/image/common/back.gif
Sub GetLinePnt()
    Dim ss As AcadSelectionSet
    Set ss = CreateSelectionSet()


我也试试,谢谢您

懵懂少年 发表于 2015-11-4 12:11:00

求vb代码，谢谢大神啊啊·····················

懵懂少年 发表于 2015-11-4 12:11:31

求vb代码，谢谢大神啊啊·····················

一只鸟243aZ 发表于 2018-5-6 21:57:18

如何过滤AcadBlockReference块中的属性（如用Block 命令手工定义的块的属性）

一只鸟243aZ 发表于 2018-5-6 22:03:10

mccad 发表于 2002-9-28 20:29
Sub GetLinePnt()
    Dim ss As AcadSelectionSet
    Set ss = CreateSelectionSet()


(entget(car(entsel)))
选择对象: ((-1 . <图元名: -14ed80>) (0 . "INSERT") (330 . <图元名: -151308>) (5 . "160")
(100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 .
"AcDbBlockReference") (66 . 1) (2 . "属性块1") (10 167.816 113.892 0.0) (41 . 1.0)
(42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210
0.0 0.0 1.0))
可是我想要通过"属性块"内的“厚度”值过滤参数该怎么办？

查看完整版本: 请帮忙吧，如何得到过滤选择集中的对象的属性呀！