[编程交流] 如何检索三维坐标i

Option Explicit
Sub Lines2Points()
Dim intCode(0) As Integer
Dim varData(0) As Variant
Dim entLine As AcadLine
Dim intLineQuantity As Integer
Dim arrLineCoords() As Variant
Dim i As Integer
Dim strMsg As String
intCode(0) = 0
varData(0) = "LINE"
intLineQuantity = (SoSSS(intCode, varData) * 2) - 1
If intLineQuantity > -1 Then
  ReDim arrLineCoords(intLineQuantity)
  For Each entLine In ThisDrawing.SelectionSets.Item("TempSSet")
     arrLineCoords(i) = entLine.StartPoint
     arrLineCoords(i + 1) = entLine.EndPoint
     i = i + 2
  Next
  For i = 0 To intLineQuantity Step 2
        strMsg = strMsg & "Start: " & PointToString(arrLineCoords(i)) _
           & "  --  End: " & PointToString(arrLineCoords(i + 1)) & vbCr
  Next
  MsgBox strMsg
  
End If
End Sub
Function SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
Dim objSSs As AcadSelectionSets
Dim objTempSS As AcadSelectionSet
Set objSSs = ThisDrawing.SelectionSets
For Each objTempSS In objSSs
  If objTempSS.Name = "TempSSet" Then
     objTempSS.Delete
     Exit For
  End If
Next
  Set objTempSS = ThisDrawing.SelectionSets.Add("TempSSet")
        'pick selection set
  If IsMissing(grpCode) Then
     objTempSS.SelectOnScreen
  Else
     objTempSS.SelectOnScreen grpCode, dataVal
  End If
  SoSSS = objTempSS.Count
End Function
Public Function PointToString(varPt As Variant) As String
Dim retVal As String, i As Long
  For i = LBound(varPt) To UBound(varPt)
      varPt(i) = Round(varPt(i), 2)
      retVal = retVal & CStr(varPt(i)) & ","
  Next
  PointToString = Left(retVal, Len(retVal) - 1)
End Function