如何从DWG图中提取出点的坐标？

zzol9970

有一个CAD图形文件，上面有4个图层，每个图层上有一条依次连接的线段，如何把线段上的端点提取出来呢。例如图中绿色的线段，实际是由3个点连接而成，怎么把这3个点的坐标提取出来呢？附件中有CAD图。

wwswwswws

选中这两个线段对象，对象的属性是就有端点的坐标

zzol9970

能够具体说一下吗，比如什么命令

pmq

    Dim Sel As AcadSelectionSet    '选择集
    Set Sel = CreateSelectionSet
    Sel.SelectOnScreen FilterType, FilterData  '屏幕选择
    For Each Obj In Sel
        Coord = Obj.Coordinates
        Select Case Obj.ObjectName
        Case "AcDbPolyline"
        Case "AcDb2dPolyline", "AcDb3dPolyline"
           For i = 0 To UBound(Coord) - 1 Step 3
               XYH(0) = Coord(i + 0)
               XYH(1) = Coord(i + 1)
               XYH(2) = Coord(i + 2)
        Case Else
        End Select
    Next

zzol9970

pmq 发表于 2014-3-1 14:12
Dim Sel As AcadSelectionSet    '选择集
    Set Sel = CreateSelectionSet
    Sel.SelectOnScreen ...

小弟是新手，这段程序是要手动选择对象吧，能不能做到自动处理呢，比如自动把一个图层选中，然后提取出坐标。

pmq

    FType(0) =8
    FData(0) = "图层名"
    FilterType = FType
    FilterData = FData

Sel.Select acSelectionSetAll, , , FilterType, FilterData   '选择全部

zzol9970

不知道是哪一步出错，选择对象个数为0。。。。。。。。。。。。

lzws03

是不是因为线段或多段线的属性问题？

yuanziyou

这难道是塔基断面?

wwswwswws

你的线是acadline，不是多段线
下面这个程序是手动先选择这几个直线，然后你运行一下

Dim lCount As Long
Dim i As Long
Dim objLine As AcadLine
dim  ssText As AcadSelectionSet
Set ssText = ThisDrawing.ActiveSelectionSet
lCount = ssText.Count
For i = 0 To lCount - 1
    If ssText.Item(i).ObjectName = "AcDbLine" Then
       Set objLine = ssText.Item(i)
       Debug.Print "sTartPoint(0)= " & objLine.StartPoint(0)
       Debug.Print "sTartPoint(1)= " & objLine.StartPoint(1)
       Debug.Print "EndPoint(0)= " & objLine.EndPoint(0)
       Debug.Print "EndPoint(1)= " & objLine.EndPoint(1)
      
    End If

Next