'由轴线直接生成框架梁或柱
Sub kuangjia()
    On Error GoTo ErrControl
    Dim W As Double
    Dim H As Double
    ThisDrawing.Utility.InitializeUserInput 1, ""
    W = ThisDrawing.Utility.GetInteger("请输入创建的实体截面宽度: ")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    H = ThisDrawing.Utility.GetInteger("请输入创建的实体截面高度: ")
    
    Dim L As AcadLine
    'Dim A As Double
    Dim P As Variant
    Dim P1 As Variant
    Dim P2 As Variant
    Dim P3(0 To 2)   As Double
    Dim M(0 To 5) As Double
    Dim A As Double, B As Double, C As Double, D As Double
    Dim T(0 To 2) As Double
    Dim Box As Acad3DSolid
    Dim J As Double
    Dim L1 As Double, L2 As Double, L3 As Double
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = CreateSelectionSet("TempObj")
    Dim FType, FData
    BuildFilter FType, FData, 0, "line"
    ssetObj.SelectOnScreen FType, FData

    ActiveDocument.Utility.Prompt "共选择直线：" & ssetObj.Count & "根" & vbCrLf
    For i = 0 To ssetObj.Count - 1
        If ssetObj.item(i).ObjectName = "AcDbLine" Then
            Set L = ssetObj.item(i)
            MsgBox L.Length
            P = CenterPoint(L.StartPoint, L.EndPoint)
            P1 = L.StartPoint
            P2 = L.EndPoint
            Set Box = ThisDrawing.ModelSpace.AddBox(P, L.Length, W, H)
        
            P3(0) = P(0) + L.Length / 2
            P3(1) = P(1)
            P3(2) = P(2)
        
            '判断三点是否在一条直线上
            If ThreeP_IsOnline(P1, P2, P3) = True Then
                ThisDrawing.Utility.Prompt "出现三点共线情况" & vbCrLf
                Exit Sub
            End If
            '计算平面方程系数
            M(0) = P2(0) - P1(0)
            M(1) = P2(1) - P1(1)
            M(2) = P2(2) - P1(2)
            M(3) = P3(0) - P1(0)
            M(4) = P3(1) - P1(1)
            M(5) = P3(2) - P1(2)
            '计算平面方程系数( Ax+By+Cz+D=0)
            A = M(1) * M(5) - M(2) * M(4)
            B = -(M(0) * M(5) - M(2) * M(3))
            C = M(0) * M(4) - M(1) * M(3)
            D = -A * P1(0) - B * P1(1) - C * P1(2)
            
            
            '过平面法线的一点
            T(0) = A * 10 + P(0)
            T(1) = B * 10 + P(1)
            T(2) = C * 10 + P(2)
            
            Box.Color = acGreen
            
            '计算空间两条直线的夹角
            L1 = L.Length / 2
            L2 = P2PDistance(P, P3)
            L3 = P2PDistance(P3, P1)
            
            '利用余弦定理 a^2=b^2+c^2-2*b*c*cos(A)
            
            J = Arccos((L1 * L1 + L2 * L2 - L3 * L3) / 2 / L1 / L2)
            
            Box.Rotate3d P, T, J
        End If
    Next i
    ssetObj.Delete
    
    Exit Sub

ErrControl:
    
    MsgBox Err.Description

End Sub

          '判断三点是否在一条直线上
            If ThreeP_IsOnline(P1, P2, P3) = True Then
                ThisDrawing.Utility.Prompt "出现三点共线情况" & vbCrLf
                Ｇｏｔｏ　xNext
            End If
             …………
xNext:
       End if
Next i
 ……