获取复合线上的极点

Public Sub PickPointsPipe()
 
    Dim objCirc As AcadCircle
    Dim dblOD As Double
    Dim varFtpt As Variant
    Dim varSdpt As Variant
    Dim objTempLine As AcadLine
    Dim dblDist As Double
    
    Dim dblRunLeng As Double
    Dim dblFullStk As Double
    Dim dblAngle As Double
    Dim varLastPt As Variant
    
    Dim objEnts() As AcadEntity
    Dim objPipe As Acad3DSolid
    Dim varRegions As Variant
    Dim varItem As Variant
 
 On Error GoTo Done
 
  With ThisDrawing
   varFtpt = .Utility.GetPoint(, vbCr & " Pick point to start pipe: ")
   varSdpt = .Utility.GetPoint(varFtpt, vbCr & " Pick point to end pipe: ")
   
   Dim dblVec(0 To 2) As Double
   dblVec(0) = varSdpt(0) - varFtpt(0): dblVec(1) = varSdpt(1) - varFtpt(1): dblVec(2) = varSdpt(2) - varFtpt(2)
  
   Dim dblVal As Double
   dblVal = Sqr(dblVec(0) * dblVec(0) + dblVec(1) * dblVec(1) + dblVec(2) * dblVec(2))
 
   Dim dblVecNorm(0 To 2) As Double
   dblVecNorm(0) = dblVec(0) / dblVal: dblVecNorm(1) = dblVec(1) / dblVal: dblVecNorm(2) = dblVec(2) / dblVal
 
  End With
   
   With ThisDrawing
   
    Set objTempLine = .ModelSpace.AddLine(varFtpt, varSdpt)
    dblDist = objTempLine.Length
    
    dblRunLeng = 10#
    dblAngle = .Utility.AngleFromXAxis(varFtpt, varSdpt)
    
    dblFullStk = (dblDist / dblRunLeng)
    objTempLine.Delete
     varLastPt = .Utility.PolarPoint(varFtpt, dblAngle, dblRunLeng)
    
    
    Dim counter As Double
    counter = 1
    Do While dblFullStk > counter
       
       varLastPt = .Utility.PolarPoint(varFtpt, dblAngle, dblRunLeng)
       Set objTempLine = .ModelSpace.AddLine(varFtpt, varLastPt)
       
       Set objCirc = .ModelSpace.AddCircle(varFtpt, 1#)
       objCirc.Normal = dblVecNorm
 
    ReDim objEnts(0)
    Set objEnts(0) = objCirc
    varRegions = .ModelSpace.AddRegion(objEnts)
    Set objPipe = .ModelSpace.AddExtrudedSolid(varRegions(0), dblRunLeng, 0)
    objPipe.Update
    objTempLine.Delete
  Debug.Print varLastPt(0) & "," & varLastPt(1) & "," & varLastPt(2)
  varFtpt = varLastPt
    
    counter = counter + 1
    For Each varItem In objEnts
   varItem.Delete
 Next
 For Each varItem In varRegions
   varItem.Delete
 Next
    
    Loop
End With
 
Done:
 If Err Then MsgBox Err.Description
End Sub