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

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:00

FData(0) = "LWPOLYLINE"

wangshuping42 · 发表于 2014-10-26 15:24:00

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

wmz · 发表于 2014-10-26 16:09:00

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

zzyong00 · 发表于 2014-10-26 16:12:00

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:00

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

wangshuping42 · 发表于 2014-10-26 17:01:00

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:00

十分谢谢！这样写能行！

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

发表回复

精选推荐