Not Pretty But something along these lines:
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