Public Sub Vhvt() On Error GoTo Err_Vhvt Dim x As Double Dim P1 As Variant Dim a As Double Dim b As Double Dim c As Double Dim d As Double Dim R As Double Dim h As Currency Dim f1 As Double Dim f2 As Double Dim e1 As Double Dim e2 As Double Dim g1 As Double Dim g2 As Double Dim h1 As Double Dim h2 As Double P1 = ThisDrawing.Utility.GetPoint(, "Chon mot diem: ") On Error Resume Next With ThisDrawing.Utility a = 15 b = 50 c = 15 d = 50 R = 10 h = 10 i1 = 0.01 i2 = 0.01 i3 = 0.01 i4 = 0.015 i5 = 0.02 i6 = 0.02 f1 = R + c / 2 f2 = R + a / 2 e1 = f1 * i1 e2 = f2 * i4 g1 = a / 2 g2 = c / 2 h1 = g1 * i2 h2 = g2 * i5 End With 'Xac dinh toa do cac diem M,N,K,L Dim M(0 To 2) As Double Dim N(0 To 2) As Double Dim K(0 To 2) As Double Dim L(0 To 2) As Double M(0) = P1(0) - R - c / 2: M(1) = P1(1): M(2) = P1(2) + (c / 2 + R) * i1 N(0) = P1(0) + R + c / 2: N(1) = P1(1): N(2) = P1(2) + (c / 2 + R) * i1 K(0) = P1(0): K(1) = P1(1) + a / 2 + R: K(2) = P1(2) + (a / 2 + R) * i4 L(0) = P1(0): L(1) = P1(1) - a / 2 - R: K(2) = P1(2) + (a / 2 + R) * i4 ' Xac dinh toa do cac diem E1_1,E1_2,E1_3,E1_4,E2_1,E2_2,E2_3,E2_4 Dim E1_1(0 To 2) As Double, E1_2(0 To 2) As Double, E1_3(0 To 2) As Double, E1_4(0 To 2) As Double Dim E2_1(0 To 2) As Double, E2_2(0 To 2) As Double, E2_3(0 To 2) As Double, E2_4(0 To 2) As Double Dim F1_1(0 To 2) As Double, F1_2(0 To 2) As Double, F1_3(0 To 2) As Double, F1_4(0 To 2) As Double Dim F2_1(0 To 2) As Double, F2_2(0 To 2) As Double, F2_3(0 To 2) As Double, F2_4(0 To 2) As Double E1_1(0) = M(0): E1_1(1) = M(1) + a / 2: E1_1(2) = M(2) - a / 2 * i2 E1_2(0) = M(0): E1_2(1) = M(1) - a / 2: E1_2(2) = M(2) - a / 2 * i2 E1_3(0) = N(0): E1_3(1) = N(1) - a / 2: E1_3(2) = N(2) - a / 2 * i2 E1_4(0) = N(0): E1_4(1) = N(1) + a / 2: E1_4(2) = N(2) - a / 2 * i2 ' Xac dinh toa do cac diem F1,F2,F3,F4 F1_1(0) = K(0) + c / 2: F1_1(1) = K(1): F1_1(2) = K(2) - c / 2 * i5 F1_2(0) = K(0) - c / 2: F1_2(1) = K(1): F1_2(2) = K(2) - c / 2 * i5 F1_3(0) = L(0) - c / 2: F1_3(1) = L(1): F1_3(2) = L(2) - c / 2 * i5 F1_4(0) = L(0) + c / 2: F1_4(1) = L(1): F1_4(2) = L(2) - c / 2 * i5 ' Xac dinh toa do cac diem E1,E2,E3,E4(diem 3 va 4) Dim E3_1(0 To 2) As Double, E3_2(0 To 2) As Double, E3_3(0 To 2) As Double, E3_4(0 To 2) As Double Dim E4_1(0 To 2) As Double, E4_2(0 To 2) As Double, E4_3(0 To 2) As Double, E4_4(0 To 2) As Double Dim F3_1(0 To 2) As Double, F3_2(0 To 2) As Double, F3_3(0 To 2) As Double, F3_4(0 To 2) As Double Dim F4_1(0 To 2) As Double, F4_2(0 To 2) As Double, F4_3(0 To 2) As Double, F4_4(0 To 2) As Double E3_1(0) = M(0) - b: E3_1(1) = M(1) + a / 2: E3_1(2) = M(2) + b * i2 E3_2(0) = M(0) - b: E3_2(1) = M(1) - a / 2: E3_2(2) = M(2) + b * i2 E3_3(0) = N(0) + b: E3_3(1) = N(1) - a / 2: E3_3(2) = N(2) + b * i2 E3_4(0) = N(0) + b: E3_4(1) = N(1) + a / 2: E3_4(2) = N(2) + b * i2 ' Xac dinh toa do cac diem F1,F2,F3,E4(diem 3 va 4) F3_1(0) = K(0) + c / 2: F3_1(1) = K(1) + d: F3_1(2) = K(2) + d * i5 F3_2(0) = K(0) - c / 2: F3_2(1) = K(1) + d: F3_2(2) = K(2) + d * i5 F3_3(0) = L(0) - c / 2: F3_3(1) = L(1) - d: F3_3(2) = L(2) + d * i5 F3_4(0) = L(0) + c / 2: F3_4(1) = L(1) - d: F3_4(2) = L(2) + d * i5 ' ve cac duong thang nam ngang va thang dung Dim duong1a_1 As AcadLine, duong1a_2 As AcadLine, duong1a_3 As AcadLine Dim duong1b_1 As AcadLine, duong1b_2 As AcadLine, duong1b_3 As AcadLine Dim duong2a_1 As AcadLine, duong2a_2 As AcadLine, duong2a_3 As AcadLine Dim duong2b_1 As AcadLine, duong2b_2 As AcadLine, duong2b_3 As AcadLine Dim duong3a_1 As AcadLine, duong3a_2 As AcadLine, duong3a_3 As AcadLine Dim duong3b_1 As AcadLine, duong3b_2 As AcadLine, duong3b_3 As AcadLine Dim duong4a_1 As AcadLine, duong4a_2 As AcadLine, duong4a_3 As AcadLine Dim duong4b_1 As AcadLine, duong4b_2 As AcadLine, duong4b_3 As AcadLine Set duong1a_1 = ThisDrawing.ModelSpace.AddLine(E1_1, E3_1) Set duong1a_2 = ThisDrawing.ModelSpace.AddLine(E1_2, E3_2) Set duong1a_3 = ThisDrawing.ModelSpace.AddLine(E3_1, E3_2) Set duong2a_1 = ThisDrawing.ModelSpace.AddLine(E1_3, E3_3) Set duong2a_2 = ThisDrawing.ModelSpace.AddLine(E1_4, E3_4) Set duong2a_3 = ThisDrawing.ModelSpace.AddLine(E3_3, E3_4) Set duong3a_1 = ThisDrawing.ModelSpace.AddLine(F1_1, F3_1) Set duong3a_2 = ThisDrawing.ModelSpace.AddLine(F1_2, F3_2) Set duong3a_3 = ThisDrawing.ModelSpace.AddLine(F3_1, F3_2) Set duong4a_1 = ThisDrawing.ModelSpace.AddLine(F1_3, F3_3) Set duong4a_2 = ThisDrawing.ModelSpace.AddLine(F1_4, F3_4) Set duong4a_3 = ThisDrawing.ModelSpace.AddLine(F3_3, F3_4) ' xac dinh tam duong tron da via Dim O1(0 To 2) As Double O1(0) = P1(0) - c / 2 - R: O1(1) = P1(1) + a / 2 + R: O1(2) = P1(2) ' ve cung tron da via thu 1 Dim Pi Pi = 4 * Atn(1) Dim tam1a_3a As Variant Dim bankinh_1 As Double Dim gocdau_1 As Double Dim goccuoi_1 As Double Dim cung1a_3a As AcadArc On Error Resume Next With ThisDrawing.Utility tam1a_3a = O1 bankinh_1 = R gocdau_1 = -90 * Pi / 180# goccuoi_1 = 0 * Pi / 180# End With Set cung1a_3a = ThisDrawing.ModelSpace.AddArc(tam1a_3a, bankinh_1, gocdau_1, goccuoi_1) objEnt.Update Dim vecto_phap_tuyen(2) As Double vecto_phap_tuyen(0) = (g1 - f2) * (e2 - h2) vecto_phap_tuyen(1) = (e1 - h1) * (g2 - f1) vecto_phap_tuyen(2) = (f1 - g2) * (f2 - g1) cung1a_3a.Normal = vecto_phap_tuyen 'chuyen goc nhin toa do Dim NewDirection(0 To 2) As Double NewDirection(0) = 1 NewDirection(1) = -1 NewDirection(2) = 1 ThisDrawing.ActiveViewport.Direction = NewDirection ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport Exit_Vhvt: Exit Sub Err_Vhvt: MsgBox "Loi, khong thuc hien duoc!", vbCritical, "Thong bao" Resume Exit_Vhvt ZoomAll End Sub