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

rockes

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

mccad

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

真太感谢老大了。呵呵

sdxylijian

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

qiush1234

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

我也试试,谢谢您

懵懂少年

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

懵懂少年

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

一只鸟243aZ

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

一只鸟243aZ

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))
可是我想要通过"属性块"内的“厚度”值过滤参数该怎么办？