3dSolid长度。

Option Explicit
 'Bryco Swamp code 5-26-07
Sub DrawCylinderCenterlineLine(oCylinder As Acad3DSolid)
    Dim Xaxis(2) As Double, Yaxis(2) As Double, Zaxis(2) As Double
    Dim Pd As Variant
    Dim i As Integer
    Dim min As Variant, max As Variant
    Dim oUcs As AcadUCS
    Dim m As Variant
    Dim oLine As AcadLine
    Dim StartPt As Variant, EndPt As Variant
    Dim Ht As Double
    Dim Zero(2) As Double
    
    'Debug.Print vbAssoc(oCylinder, 1)
    
    Pd = oCylinder.PrincipalDirections
    For i = 0 To 2
        Xaxis(i) = Pd(i)
        Yaxis(i) = Pd(i + 3)
        Zaxis(i) = Pd(i + 6)
    Next i
    
    Set oUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, "3d")
    oUcs.Origin = oCylinder.Centroid
    
    m = oUcs.GetUCSMatrix
    oCylinder.TransformBy (InverseMatrix(m))
    oCylinder.GetBoundingBox min, max
     
    Ht = (max(2) - min(2)) / 2
    StartPt = Zero
    StartPt(2) = StartPt(2) - Ht
    EndPt = Zero
    EndPt(2) = EndPt(2) + Ht
    Set oLine = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
    oLine.TransformBy m
    oCylinder.TransformBy m
End Sub
Sub Test()
    Dim Ent As AcadEntity, V, C As Acad3DSolid
    ThisDrawing.Utility.GetEntity Ent, V, "Pick"
    If TypeOf Ent Is Acad3DSolid Then
        Set C = Ent
        DrawCylinderCenterlineLine C
    End If
End Sub
Function Rd(num1 As Variant, num2 As Variant) As Boolean
    Dim dRet As Double
    dRet = num1 - num2
    If Abs(dRet)  0 Then
                pivot = Matrix(i, J)
                iP = J
                Exit For
            End If
        Next J
        For k = 0 To RowCt
            If Not k = i Then
                PC = Matrix(k, iP)
                If PC = 0 Then GoTo skip
                Sign = 1
                If pivot  0 Then
                        Sign = -1
                    End If
                End If
                
                Dim n1 As Double, n2 As Double
                n1 = Abs(pivot): n2 = Abs(PC)
                Den = LCD(n1, n2)
            
                For J = 0 To ColCt
                    dTemp = Matrix(k, J) * n1 / Den + (Matrix(i, J) * n2 / Den * Sign)
                    If Rd(dTemp, 0) Then
                        Matrix(k, J) = 0
                    Else
                        Matrix(k, J) = dTemp
                    End If
                Next J
            End If
skip:
        Next k
    Next i
    
    For i = 0 To RowCt
        For J = 0 To ColCt
            If Matrix(i, J)  0 Then
                pivot = 1 / Matrix(i, J)
                Exit For
            End If
        Next J
        For J = 0 To ColCt
            Matrix(i, J) = Matrix(i, J) * pivot
        Next J
    Next i
    
    MPivot = Matrix
    
End Function
Function OrderMatrix(Matrix As Variant) As Variant
    Dim i As Integer, J As Integer
    Dim k As Integer, l As Integer
    Dim RowCt As Integer, ColCt As Integer
    RowCt = UBound(Matrix, 1)
    ColCt = UBound(Matrix, 2)
    ReDim tempRow(ColCt) As Double
    'ij is row,column
    
    For i = 0 To RowCt
        For J = 0 To ColCt
            If J = i Then
                If Not Rd(Matrix(i, J), 1) Then
                    For k = 0 To RowCt
                        If Not k = i Then
                            If Rd(Matrix(k, J), 1) Then
                                For l = 0 To ColCt
                                    tempRow(l) = Matrix(k, l)
                                    Matrix(k, l) = Matrix(i, l)
                                    Matrix(i, l) = tempRow(l)
                                Next l
                            End If
                        End If
                    Next k
                End If
            End If
        Next J
    Next i
    OrderMatrix = Matrix
End Function
Function Transpose(Matrix As Variant) As Variant
    Dim iCnt As Integer, jCnt As Integer
    Dim transMat(0 To 3, 0 To 3) As Double
    Dim i As Integer, J As Integer
    iCnt = UBound(Matrix, 1)
    jCnt = UBound(Matrix, 2)
    For i = 0 To iCnt
        For J = 0 To jCnt
            transMat(i, J) = Matrix(J, i)
        Next J
    Next i
    Transpose = transMat
    
End Function
Function LCD(n1, n2) As Integer
    'LowestCommonDenominator
    Dim iCt As Integer, i As Integer
    Dim Ans As Integer
    Ans = 1
    If n1  1 Then
        For i = 1 To iCt
            If (n1 Mod i = 0 And n2 Mod i = 0) Then Ans = i
        Next i
    End If
    LCD = Ans
    
End Function