wmz 发表于 2014-10-26 15:07:00

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

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 发表于 2014-10-26 15:17:56

FData(0) = "LWPOLYLINE"

wangshuping42 发表于 2014-10-26 15:24:31

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

wmz 发表于 2014-10-26 16:09:12

zzyong00 发表于 2014-10-26 15:17 static/image/common/back.gif
FData(0) = "LWPOLYLINE"

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

zzyong00 发表于 2014-10-26 16:12:19

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 发表于 2014-10-26 16:17:12

本帖最后由 wmz 于 2014-10-26 16:26 编辑

wangshuping42 发表于 2014-10-26 15:24 static/image/common/back.gif
楼上正解，不过你这还有问题。
UBound(ent.Coordinates) \ 2应该是(UBound(ent.Coordinates) -1)/2
接下来 ...
谢谢！不过问题不在这儿，那是可以处理的。问题在这一句：ent.Coordinates
提示类型不匹配，我刚才换成 Dim ent As AcadLWPolyline对象也是一样》

wangshuping42 发表于 2014-10-26 17:01:45

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 发表于 2014-10-26 18:47:02

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

十分谢谢！这样写能行！
页: [1]
查看完整版本: 请教如何得到多段线里的顶点坐标