Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
dienhoa

định nghĩa đường spline trong VBA

Các bài được khuyến nghị

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×