shouhua000 发表于 2011-11-7 11:21:26

获取autocad当前窗口的所有竖直方向的直线的X坐标

请问如何获取autocad当前窗口的所有竖直方向的直线的X坐标，并把所获取的坐标保存到一个数组里，与此同时 判断出这些直线属于哪个图层的，谢谢各位大侠

wylong 发表于 2011-11-10 15:08:55

Sub SelectLine()
    Dim sS As AcadSelectionSet
    Dim objLine As AcadLine
    Dim LineDelta As Variant
    Dim removeObjects() As AcadEntity


    Dim fType(0 To 0) As Integer
    Dim fData(0 To 0) As Variant
    Dim AutoSelect As Boolean

    'AutoSelect = True

    On Error Resume Next
    ThisDrawing.SelectionSets("SelectText").Delete
    Set sS = ThisDrawing.SelectionSets.Add("SelectText")
    On Error GoTo 0

    On Error GoTo ErrHandle

    '创建过滤机制
    fType(0) = 0: fData(0) = "LINE"         '直线

    '选择符合条件的所有图元－单行文字和多行文字
    If AutoSelect Then
      '自动选择方式
      sS.Select acSelectionSetAll, , , fType, fData
    Else
      '提示用户选择
      sS.SelectOnScreen fType, fData
    End If
    If sS.Count = 0 Then Exit Sub
    i = 0

    For Each objLine In sS
      LineDelta = objLine.Delta
      If LineDelta(0) <> 0 Then
            ReDim Preserve removeObjects(i)
            Set removeObjects(i) = objLine
            i = i + 1
      End If
    Next
   
    sS.RemoveItems removeObjects
      
    For Each objLine In sS
      a = objLine.StartPoint
      b = a(0)
      c = c & b & vbNewLine
    Next
   
    MsgBox c

    '删除数组
    Erase fType: Erase fData: Erase removeObjects: Erase LineDelta

    '删除选择集
    sS.Clear: sS.Delete
   
    Set sS = Nothing
    Set objLine = Nothing

    Exit Sub
ErrHandle:
    MsgBox Err.Description, vbCritical, "产生了以下错误:"
    Err.Clear
End Sub

黄玉宏 发表于 2011-11-10 16:42:42

领教了，沙发高手。是我们学习的榜样。谢谢。

shouhua000 发表于 2011-11-11 09:36:41

wylong 发表于 2011-11-10 15:08 static/image/common/back.gif


谢谢wylong的答案 ，有个问题不太明白   a,b,c都没有定义呀， c = c & b & vbNewLine
这条语句的作用是什么呢？还有就是 怎么才能判断直线所在的图层啊

黄玉宏 发表于 2011-11-11 20:59:31

可以不定义，VB允许这样，实际为变体数组(包含所有)。b为每个竖直直线的起点的X坐标， c = c & b & vbNewLine作用：所有起点X坐标换行，vbNewline作用换行相当于vbCrLf，它是VB6新增的。这样显示出来的坐标是一行一个。图层名问题： objLine.Layer
页: [1]
查看完整版本: 获取autocad当前窗口的所有竖直方向的直线的X坐标