[求助]：VBA编程

kfygl

请教各位，在VBA中用GetEntity方法从CAD屏幕中取得用二维多义线（LightweightPolyline）生成的多边形后，如何获得所选择的多边形的顶点坐标。

lsjjm

请参考
http://www.xdcad.net/forum/showthread.php?threadid=120335

kfygl

谢谢lsjjm的帮助。

ShiwJeff

查看msdn帮助文件，里面有说明，应该是coorda……函数可取，
code::设置多义线宽度，原理应该差不多
Sub polylinechange()                          
Dim ssetobj As AcadSelectionSet
Dim filtertype(0) As Integer
Dim filterdata(0) As Variant
filtertype(0) = 0
filterdata(0) = "lwpolyline"
Set ssetobj = AcadApp.ActiveDocument.SelectionSets.Add("origin68")
AppActivate AcadApp.Caption
ssetobj.SelectOnScreen filtertype, filterdata
Dim index1 As Long
Dim index2 As Long
Dim segment As Long
Dim retcoord As Variant
Dim nbr_of_segments As Long
Dim nbr_of_vertices As Long
Dim retval As Double
retval = AcadApp.ActiveDocument.Utility.GetReal("请输入多义线的宽度:")
Dim i As Integer
Dim pickedobj As Object
For i = 0 To ssetobj.Count - 1 Step 1
Set pickedobj = ssetobj.Item(i)
retcoord = pickedobj.Coordinates
segment = 0
index1 = LBound(retcoord)                 ' Start index of coordinates array
index2 = UBound(retcoord)
nbr_of_vertices = ((index2 - index1) \ 2) + 1
    If pickedobj.Closed Then
        nbr_of_segments = nbr_of_vertices
    Else
        nbr_of_segments = nbr_of_vertices - 1
    End If
     Do While nbr_of_segments > 0
         pickedobj.SetWidth segment, retval, retval

        segment = segment + 1
        nbr_of_segments = nbr_of_segments - 1
    Loop

Next i
ssetobj.Delete
End Sub