请教如何得到多段线里的顶点坐标

wmz

Sub xzj()
'这样写不行，请教解决办法。我想得到多段线里的顶点坐标
     Dim i As Integer, j As Integer
     Dim ss1 As AcadSelectionSet
     Dim mode As Integer
     Dim ent As AcadPolyline
     Dim Y As Double, X As Double
     Dim FType(1) As Integer, FData(1) As Variant
   '  On Error GoTo a0
      mode = acSelectionSetWindowPolygon
     FType(0) = 0: FData(0) = "POLYLINE"
     FType(1) = 8: FData(1) = "SJW"
     Set ss1 = ThisDrawing.SelectionSets.Add("Ps1" & Time)
     ss1.Select acSelectionSetAll, mode, , FType, FData
     For Each ent In ss1
        For j = 0 To UBound(ent.Coordinates) \ 2
            X = ent.Coordinates(j * 2)
            Y = ent.Coordinates(j * 2 + 1)
        Next j
     Next
      ss1.Clear
      ss1.Delele
     Exit Sub
a0:

       ss1.Clear
       ss1.Delete
    MsgBox "发生了" & Err.Description & "错误"
  End Sub

zzyong00

FData(0) = "LWPOLYLINE"

wangshuping42

楼上正解，不过你这还有问题。
UBound(ent.Coordinates) \ 2应该是(UBound(ent.Coordinates) -1)/2
接下来，你的X、Y应该搞成数组，否则只能接收最后一个点坐标

wmz

zzyong00 发表于 2014-10-26 15:17
FData(0) = "LWPOLYLINE"

可是我所选择的确实是"POLYLINE"对象，那咋办？

zzyong00

POLYLINE对象Coordinates属性是三维点，就是xyz....
UBound(ent.Coordinates) \ 2那当然不行了
坐标个数应该（UBound(ent.Coordinates) +1）\ 3
访问：
for i=0 to （UBound(ent.Coordinates) +1）\ 3-1
......
next i

wmz

wangshuping42 发表于 2014-10-26 15:24
楼上正解，不过你这还有问题。
UBound(ent.Coordinates) \ 2应该是(UBound(ent.Coordinates) -1)/2
接下来 ...

谢谢！不过问题不在这儿，那是可以处理的。问题在这一句：ent.Coordinates
提示类型不匹配，我刚才换成 Dim ent As AcadLWPolyline对象也是一样》

wangshuping42

Sub xzj()
'这样写不行，请教解决办法。我想得到多段线里的顶点坐标
     Dim i As Integer, j As Integer, Points As Variant
     Dim ss1 As AcadSelectionSet
     Dim mode As Integer
     Dim ent As AcadEntity
     Dim Y As Double, X As Double
     Dim FType(1) As Integer, FData(1) As Variant
     
     On Error GoTo a0
     FType(0) = 0: FData(0) = "LWPOLYLINE"
     FType(1) = 8: FData(1) = "0"  '"SJW"
     Set ss1 = ThisDrawing.SelectionSets.Add("Ps1" & Time)
     ss1.Select acSelectionSetAll, , , FType, FData
     
     For Each ent In ss1
        Points = ent.Coordinates
        For j = 0 To (UBound(Points) - 1) / 2
            X = Points(j * 2)
            Y = Points(j * 2 + 1)
            Debug.Print X & ";" & Y
        Next j
     Next
     
      ss1.Clear
      ss1.Delete
     Exit Sub
     
a0:
       ss1.Clear
       ss1.Delete
      
    MsgBox "发生了" & Err.Description & "错误"
   
End Sub

wmz

wangshuping42 发表于 2014-10-26 17:01
Sub xzj()
'这样写不行，请教解决办法。我想得到多段线里的顶点坐标
     Dim i As Integer, j As Integ ...

十分谢谢！这样写能行！