[编程交流] DXF中的顶点

Sub StoreCoordsInArray3d()
Dim entPline As AcadLWPolyline
Dim varPt As Variant
Dim ent As AcadEntity
Dim coords As Variant
Dim dblPtArray() As Double
Dim intBound As Integer
Dim i As Integer
Dim strMsg As String
Dim varNormal As Variant
Dim dblElev As Double
Dim dblPt(2) As Double
Dim varTrans As Variant
  With ThisDrawing
     On Error Resume Next
     .Utility.GetEntity ent, varPt, "Select a Poly:"
     If Err <> 0 Then Exit Sub
     On Error GoTo 0
     If TypeOf ent Is AcadLWPolyline Then
        Set entPline = ent
        dblElev = entPline.Elevation
        varNormal = entPline.Normal
        coords = entPline.Coordinates
        intBound = ((UBound(coords) + 1) / 2) - 1
        ReDim dblPtArray(intBound, 2)
        For i = 0 To intBound
           dblPt(0) = coords(2 * i)
           dblPt(1) = coords((2 * i) + 1)
           dblPt(2) = dblElev
           varTrans = .Utility.TranslateCoordinates(dblPt, acOCS, acWorld, 0, varNormal)
           dblPtArray(i, 0) = varTrans(0)
           dblPtArray(i, 1) = varTrans(1)
           dblPtArray(i, 2) = varTrans(2)
           strMsg = strMsg & CStr(dblPtArray(i, 0)) & ", "
           strMsg = strMsg & CStr(dblPtArray(i, 1)) & ", "
           strMsg = strMsg & CStr(dblPtArray(i, 2)) & vbCr
        Next
        MsgBox strMsg
        
     End If
     
  End With
End Sub