'由轴线直接生成框架梁或柱
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