dienhoa 0 Báo cáo bài đăng Đã đăng Tháng 1 9, 2013 nhờ các bác giúp em với.em đang không hiểu cái chỗ phần tiếp đầu và tiếp cuối của đường spline.em đã thử vẽ ngoài giao diện của cad thì đúng,còn lập trình tự dịnh nghĩa cho nó thì nó vẽ lại sai và lúc được lúc không,phải chạy nhiều lần mới được cái đường hơi ưng ý tý.nhưng không đường tốt lắm. 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 denta_h As Currency Dim denta_h1 As Currency Dim denta_h2 As Currency Dim i1 As Double Dim i2 As Double Dim i3 As Double Dim i4 As Double Dim i5 As Double Dim i6 As Double Dim itb_1 As Double Dim hs As Currency Dim hi_1 As Currency Dim hi_2 As Currency Dim hi_3 As Currency Dim hi_4 As Currency Dim hi_5 As Currency Dim hi_6 As Currency Dim hi_7 As Currency Dim hi_8 As Currency P1 = ThisDrawing.Utility.GetPoint(, "Chon mot diem: ") x = ThisDrawing.Utility.GetDistance(, "Chon so thu tu cua nut can thiet ke: ") On Error Resume Next With ThisDrawing.Utility a = 20 b = 50 c = 10 d = 50 R = 20 h = 10 denta_h = 0.05 denta_h1 = 0.05 denta_h2 = 0.03 i1 = 0.01 i2 = 0.02 i3 = 0.02 i4 = 0.015 i5 = 0.02 i6 = 0.02 hs = 1.414213562 End With Dim PA1(0 To 2) As Double, PA2(0 To 2) As Double, PB1(0 To 2) As Double, PB2(0 To 2) As Double Dim PC1(0 To 2) As Double, PC2(0 To 2) As Double, PD1(0 To 2) As Double, PD2(0 To 2) As Double PA1(0) = P1(0) - c / 2 - R: PA1(1) = P1(1) + a / 2: PA1(2) = P1(2) PA2(0) = P1(0) - c / 2: PA2(1) = P1(1) + a / 2 + R: PA2(2) = P1(2) PB1(0) = P1(0) - c / 2 - R: PB1(1) = P1(1) - a / 2: PB1(2) = P1(2) PB2(0) = P1(0) - c / 2: PB2(1) = P1(1) - a / 2 - R: PB2(2) = P1(2) PC1(0) = P1(0) + c / 2 + R: PC1(1) = P1(1) - a / 2: PC1(2) = P1(2) PC2(0) = P1(0) + c / 2: PC2(1) = P1(1) - a / 2 - R: PC2(2) = P1(2) PD1(0) = P1(0) + c / 2 + R: PD1(1) = P1(1) + a / 2: PD1(2) = P1(2) PD2(0) = P1(0) + c / 2: PD2(1) = P1(1) + a / 2 + R: PD2(2) = P1(2) ' ve duong chinh Dim L01 As AcadLine, L02 As AcadLine Dim L05 As AcadLine, L06 As AcadLine Dim P01(0 To 2) As Double, P02(0 To 2) As Double Dim P05(0 To 2) As Double, P06(0 To 2) As Double P01(0) = P1(0) - c / 2 - b: P01(1) = P1(1) + a / 2: P01(2) = P1(2) P02(0) = P1(0) - c / 2 - b: P02(1) = P1(1) - a / 2: P02(2) = P1(2) P05(0) = P1(0) + c / 2 + b: P05(1) = P1(1) - a / 2: P05(2) = P1(2) P06(0) = P1(0) + c / 2 + b: P06(1) = P1(1) + a / 2: P06(2) = P1(2) Set L01 = ThisDrawing.ModelSpace.AddLine(PA1, P01) Set L02 = ThisDrawing.ModelSpace.AddLine(PB1, P02) Set L05 = ThisDrawing.ModelSpace.AddLine(PC1, P05) Set L06 = ThisDrawing.ModelSpace.AddLine(PD1, P06) ' ve duong phu Dim L03 As AcadLine, L04 As AcadLine Dim L07 As AcadLine, L08 As AcadLine Dim P03(0 To 2) As Double, P04(0 To 2) As Double Dim P07(0 To 2) As Double, P08(0 To 2) As Double P03(0) = P1(0) - c / 2: P03(1) = P1(1) - a / 2 - d: P03(2) = P1(2) P04(0) = P1(0) + c / 2: P04(1) = P1(1) - a / 2 - d: P04(2) = P1(2) P07(0) = P1(0) + c / 2: P07(1) = P1(1) + a / 2 + d: P07(2) = P1(2) P08(0) = P1(0) - c / 2: P08(1) = P1(1) + a / 2 + d: P08(2) = P1(2) Set L03 = ThisDrawing.ModelSpace.AddLine(PB2, P03) Set L04 = ThisDrawing.ModelSpace.AddLine(PC2, P04) Set L07 = ThisDrawing.ModelSpace.AddLine(PD2, P07) Set L08 = ThisDrawing.ModelSpace.AddLine(PA2, P08) ' ghi chu ' Xac dinh vi tri diem can ghi Dim P As AcadPoint Dim vitri(0 To 2) As Double vitri(0) = P1(0): vitri(1) = P1(1): vitri(2) = P1(2) Set P = ThisDrawing.ModelSpace.AddPoint(vitri) ThisDrawing.SetVariable "PDMODE", 34 ThisDrawing.SetVariable "PDSIZE", 0.5 ' ghi chu bang text Dim textObj As AcadText Dim textString As String Dim insertionPoint(0 To 2) As Double Dim height As Double textString = "P" insertionPoint(0) = P1(0) + 1 insertionPoint(1) = P1(1) + 0 height = 0.5 Set textObj = ThisDrawing.ModelSpace. _ AddText(textString, insertionPoint, height) textObj.height = 0.5 textObj.Update ' ve cung tron da via ' xac dinh tam duong tron da via Dim O1(0 To 2) As Double, O2(0 To 2) As Double Dim O3(0 To 2) As Double, O4(0 To 2) As Double O1(0) = P1(0) - c / 2 - R: O1(1) = P1(1) + a / 2 + R: O1(2) = P1(2) O2(0) = P1(0) - c / 2 - R: O2(1) = P1(1) - a / 2 - R: O2(2) = P1(2) O3(0) = P1(0) + c / 2 + R: O3(1) = P1(1) - a / 2 - R: O3(2) = P1(2) O4(0) = P1(0) + c / 2 + R: O4(1) = P1(1) + a / 2 + R: O4(2) = P1(2) ' ve cung tron da via thu 1 Dim Pi Pi = 4 * Atn(1) Dim tam_1 As Variant Dim bankinh_1 As Double Dim gocdau_1 As Double Dim goccuoi_1 As Double Dim cung_1 As AcadArc On Error Resume Next With ThisDrawing.Utility tam_1 = O1 bankinh_1 = R gocdau_1 = -90 * Pi / 180# goccuoi_1 = 0 * Pi / 180# End With Set cung_1 = ThisDrawing.ModelSpace.AddArc(tam_1, bankinh_1, gocdau_1, goccuoi_1) objEnt.Update ' ve cung tron da via thu 2 Dim tam_2 As Variant Dim bankinh_2 As Double Dim gocdau_2 As Double Dim goccuoi_2 As Double Dim cung_2 As AcadArc On Error Resume Next With ThisDrawing.Utility tam_2 = O2 bankinh_2 = R gocdau_2 = 0 * Pi / 180# goccuoi_2 = 90 * Pi / 180# End With Set cung_2 = ThisDrawing.ModelSpace.AddArc(tam_2, bankinh_2, gocdau_2, goccuoi_2) objEnt.Update ' ve cung tron da via thu 3 Dim tam_3 As Variant Dim bankinh_3 As Double Dim gocdau_3 As Double Dim goccuoi_3 As Double Dim cung_3 As AcadArc On Error Resume Next With ThisDrawing.Utility tam_3 = O3 bankinh_3 = R gocdau_3 = 90 * Pi / 180# goccuoi_3 = 180 * Pi / 180# End With Set cung_3 = ThisDrawing.ModelSpace.AddArc(tam_3, bankinh_3, gocdau_3, goccuoi_3) objEnt.Update ' ve cung tron da via thu 4 Dim tam_4 As Variant Dim bankinh_4 As Double Dim gocdau_4 As Double Dim goccuoi_4 As Double Dim cung_4 As AcadArc On Error Resume Next With ThisDrawing.Utility tam_4 = O4 bankinh_4 = R gocdau_4 = -180 * Pi / 180# goccuoi_4 = -90 * Pi / 180# End With Set cung_4 = ThisDrawing.ModelSpace.AddArc(tam_4, bankinh_4, gocdau_4, goccuoi_4) objEnt.Update 've duong dong muc ben ngoai nut giao thong '' xac dinh vi tri cac diem K,L,M,N Dim K As AcadPoint, L As AcadPoint Dim M As AcadPoint, n As AcadPoint Dim K1(0 To 2) As Double, L1(0 To 2) As Double Dim M1(0 To 2) As Double, N1(0 To 2) As Double K1(0) = P1(0): K1(1) = P1(1) + a / 2 + R: K1(2) = P1(2) L1(0) = P1(0): L1(1) = P1(1) - a / 2 - R: L1(2) = P1(2) M1(0) = P1(0) - c / 2 - R: M1(1) = P1(1): M1(2) = P1(2) N1(0) = P1(0) + c / 2 + R: N1(1) = P1(1): N1(2) = P1(2) Set K = ThisDrawing.ModelSpace.AddPoint(K1) Set L = ThisDrawing.ModelSpace.AddPoint(L1) Set M = ThisDrawing.ModelSpace.AddPoint(M1) Set n = ThisDrawing.ModelSpace.AddPoint(N1) ThisDrawing.SetVariable "PDMODE", 0 ThisDrawing.SetVariable "PDSIZE", 0.5 '' ghi chu cac diem K,L,M,N ''' ghi chu K Dim textK_1 As AcadText Dim K_1 As String Dim diem_dat_K(0 To 2) As Double Dim cao_K As Double K_1 = "K" diem_dat_K(0) = K1(0) + 0 diem_dat_K(1) = K1(1) - 1 cao_K = 0.5 Set textK_1 = ThisDrawing.ModelSpace.AddText(K_1, diem_dat_K, cao_K) textObj.cao_K = 0.5 textObj.Update ''' ghi chu L Dim textL_1 As AcadText Dim L_1 As String Dim diem_dat_L(0 To 2) As Double Dim cao_L As Double L_1 = "L" diem_dat_L(0) = L1(0) + 0 diem_dat_L(1) = L1(1) + 1 cao_L = 0.5 Set textL_1 = ThisDrawing.ModelSpace.AddText(L_1, diem_dat_L, cao_L) textObj.cao_L = 0.5 textObj.Update '' ghi chu M Dim textM_1 As AcadText Dim M_1 As String Dim diem_dat_M(0 To 2) As Double Dim cao_M As Double M_1 = "M" diem_dat_M(0) = M1(0) + 1 diem_dat_M(1) = M1(1) + 0 cao_M = 0.5 Set textM_1 = ThisDrawing.ModelSpace.AddText(M_1, diem_dat_M, cao_M) textObj.cao_M = 0.5 textObj.Update '' ghi chu N Dim textN_1 As AcadText Dim N_1 As String Dim diem_dat_N(0 To 2) As Double Dim cao_N As Double N_1 = "N" diem_dat_N(0) = N1(0) + -1 diem_dat_N(1) = N1(1) + 0 cao_N = 0.5 Set textN_1 = ThisDrawing.ModelSpace.AddText(N_1, diem_dat_N, cao_N) textObj.cao_N = 0.5 textObj.Update ' Xac dinh cao do cac diem M,N,K,L Dim hM As Currency Dim hN As Currency Dim hK As Currency Dim hL As Currency Dim hM1 As Currency Dim hN1 As Currency Dim hK1 As Currency Dim hL1 As Currency On Error Resume Next With ThisDrawing.Utility hM = h - ((c / 2) + R) * i1 hN = h - ((c / 2) + R) * i1 hK = h - ((a / 2) + R) * i4 hL = h - ((a / 2) + R) * i4 hM1 = h + ((c / 2) + R) * i1 hN1 = h + ((c / 2) + R) * i1 hK1 = h + ((a / 2) + R) * i4 hL1 = h + ((a / 2) + R) * i4 End With ' Xac dinh cao do cac diem F1,F2,F3,F4,E1,E2,E3,E4 Dim hF1 As Double Dim hF2 As Double Dim hF3 As Double Dim hF4 As Double Dim hE1 As Double Dim hE2 As Double Dim hE3 As Double Dim hE4 As Double Dim F1(0 To 2) As Double Dim F2(0 To 2) As Double Dim F3(0 To 2) As Double Dim F4(0 To 2) As Double Dim E1(0 To 2) As Double Dim E2(0 To 2) As Double Dim E3(0 To 2) As Double Dim E4(0 To 2) As Double On Error Resume Next E1(0) = M1(0): E1(1) = M1(1) + a / 2: E1(2) = M1(2) E2(0) = M1(0): E2(1) = M1(1) - a / 2: E2(2) = M1(2) E3(0) = N1(0): E3(1) = N1(1) - a / 2: E3(2) = N1(2) E4(0) = N1(0): E4(1) = N1(1) + a / 2: E4(2) = N1(2) F1(0) = K1(0) + c / 2: F1(1) = K1(1): E1(2) = K1(2) F2(0) = K1(0) - c / 2: F2(1) = K1(1): E2(2) = K1(2) F3(0) = L1(0) - c / 2: F3(1) = L1(1): F3(2) = L1(2) F4(0) = L1(0) + c / 2: F4(1) = L1(1): F4(2) = L1(2) With ThisDrawing.Utility hF1 = hK - c / 2 * i2 hF2 = hK - c / 2 * i2 hF3 = hL - c / 2 * i2 hF4 = hL - c / 2 * i2 hE1 = hM - a / 2 * i5 hE4 = hM - a / 2 * i5 hE2 = hN - a / 2 * i5 hE3 = hN - a / 2 * i5 End With ' ve duong dong muc ngoai nut duong chinh '' tinh cac chieu dai L1,L2 Dim L1_M As Double Dim L2_M As Double On Error Resume Next With ThisDrawing.Utility L1_M = denta_h / i1 L2_M = a * i2 / 2 / i3 End With If x = 1 Or x = 2 Then '' ve duong dong muc qua hai diem duong so 1a ''' ve Dim dongmuc_1 As AcadSpline Dim Mi_3(0 To 2) As Double, Mi_1(0 To 2) As Double, Mi_2(0 To 2) As Double Dim dongmucsp_1(0 To 14) As Double Dim Li As Double Dim La As Double Dim Lb As Double Dim Lc As Double Dim Li_1 As Double Dim Li_2 As Double Dim Li_3 As Double Dim Li_4 As Double Dim hOM As Currency On Error Resume Next With ThisDrawing.Utility Li = 0 hOM = hM1 - denta_h La = -L2_M / 2 Lb = -L2_M / 4 Lc = -3 * L2_M / 4 End With Do While Li <= (b - R - L2_M) And La <= (b - R - L2_M) Li_1 = Li + L2_M Li_2 = La + L2_M Li_3 = Lb + L2_M Li_4 = Lc + L2_M hi_1 = hOM + denta_h Mi_3(0) = M1(0) - Li: Mi_3(1) = M1(1): Mi_3(2) = M1(2) dongmucsp_1(0) = M1(0) - Li_1: dongmucsp_1(1) = M1(1) + a / 2: dongmucsp_1(2) = M1(2) dongmucsp_1(3) = M1(0) - Li_2 + 0.3: dongmucsp_1(4) = M1(1) + a / 4: dongmucsp_1(5) = M1(2) dongmucsp_1(6) = M1(0) - Li: dongmucsp_1(7) = M1(1): dongmucsp_1(8) = M1(2) dongmucsp_1(9) = M1(0) - Li_2 + 0.3: dongmucsp_1(10) = M1(1) - a / 4: dongmucsp_1(11) = M1(2) dongmucsp_1(12) = M1(0) - Li_1: dongmucsp_1(13) = M1(1) - a / 2: dongmucsp_1(14) = M1(2) Mi_1(0) = M1(0) - Li_1 - L2_M: Mi_1(1) = M1(1) + a: Mi_1(2) = M1(2) Mi_2(0) = M1(0) - Li_1 - L2_M: Mi_2(1) = M1(1) - a: Mi_2(2) = M1(2) Set dongmuc_1 = ThisDrawing.ModelSpace.AddSpline(dongmucsp_1, Mi_1, Mi_2) ''' ghi chu dong muc Dim chu_cd_1 As AcadText Dim dd_dm_1(0 To 2) As Double Dim cd_1 As Double dd_dm_1(0) = Mi_3(0) - 2: dd_dm_1(1) = Mi_3(1): dd_dm_1(2) = Mi_3(2) cd_1 = 0.5 Set chu_cd_1 = ThisDrawing.ModelSpace.AddText(hi_1, dd_dm_1, cd_1) textObj.cd_1 = 0.5 textObj.Update Li = Li + L1_M La = La + L1_M Lb = Lb + L1_M Lc = Lc + L1_M hOM = hOM + denta_h Loop End If Exit Sub Err_Vhvt: MsgBox "Loi, khong thuc hien duoc!", vbCritical, "Thong bao" Resume Exit_Vhvt ZoomAll End Sub Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác