Code vẽ mặt cắt với những kích thước khác nhau qua số liệu từ excel

[whiterose232]

Đây là một chương trình ví dụ qua code VBA các bạn có thể vẽ được nhiều mặt cắt hình dạng giống nhau nhưng kích thước giống nhau thông qua số liệu các bạn nhập từ Excel. Bản Excel này các bạn có thể tự lập. Một điểm cần lưu ý ở đây chính là đường dẫn liên kết bản excel các bạn nhập số liệu trên VBA và tên của bản Excel đó (dòng này mình đã in đậm). Chương trình này mình viết với hình dạng mặt cắt mình có. Các bạn với những mặt cắt khác có thể làm tương tự. Hình dạng mặt cắt của mình các bạn có thể xem trong Form bài viết trước của mình đã gửi (bài viết http://www.giaiphapexcel.com/forum/showthread.php?62739-Ví-dụ-đơn-giản-về-vẽ-cad-qua-code-VBA) để nhập số liệu cho thích hợp.Mình mong bài này có thể giúp ích gì đó cho các bạn. Trong phần code bài này phần đầu không khác chương trình mình đã gửi kia chỉ thêm một chương trình con liên kết với excel, bên cạnh đó mình có sửa một chút ở đường kích thước kt8 chương trình trước có một chút lỗi nhỏ ở đó.

Option Explicit
'khai bao du lieu mo ta
Public Type D_Cau
b1 As Double
b2 As Double
b3 As Double
b4 As Double
b5 As Double
b6 As Double
h1 As Double
h2 As Double
h3 As Double
h4 As Double
h5 As Double
h6 As Double
End Type
'khai bao du lieu toan cuc
Public Const kcDim = 10
Public Const pi = 3.14159265358979
'chuong trinh const ve D_Cau
Private Sub veDcau(Cau As D_Cau, Gocve As Variant)
Dim L(1 To 15) As AcadLine
Dim SP As Variant, EP As Variant
've cac duong thang
ThisDrawing.ActiveLayer = ThisDrawing.Layers("netdam")
'line1
SP = Gocve: SP(0) = SP(0) - Cau.b1 / 2
EP = SP: EP(0) = EP(0) + Cau.b1
Set L(1) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line 2
EP = SP: EP(1) = EP(1) - Cau.h1
Set L(2) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line3
SP = EP: EP(0) = EP(0) + Cau.b2
Set L(3) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line4
SP = EP: EP(1) = EP(1) - Cau.h2
Set L(4) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line5
SP = EP: EP(0) = EP(0) + Cau.b3: EP(1) = EP(1) - Cau.h3
Set L(5) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line6
SP = EP: SP(0) = Gocve(0) - (Cau.b1 / 2 - Cau.b2 - Cau.b3)
EP(0) = SP(0) + Cau.b1 - 2 * Cau.b2 - 2 * Cau.b3
Set L(6) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line7
SP = EP: SP(0) = SP(0) - 2 * (Cau.b1 / 2 - Cau.b2 - Cau.b3) + Cau.b6
EP = SP: EP(1) = EP(1) - Cau.h4
Set L(7) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line8
SP = EP: EP(0) = EP(0) + Cau.b4
Set L(8) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line9
EP = SP: EP(0) = EP(0) - Cau.b5: EP(1) = EP(1) - Cau.h5
Set L(9) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line10
SP = EP: EP(0) = EP(0) + 2 * Cau.b5 + Cau.b4
Set L(10) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line11
EP = SP: EP(1) = EP(1) - Cau.h6
Set L(11) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line12
SP = EP: EP(0) = EP(0) + Cau.b4 + 2 * Cau.b5
Set L(12) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line13
SP = EP: EP(1) = EP(1) + Cau.h6
Set L(13) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line14
SP = EP: EP(0) = EP(0) - Cau.b5: EP(1) = EP(1) + Cau.h5
Set L(14) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'line15
SP = EP: EP(1) = EP(1) + Cau.h4
Set L(15) = ThisDrawing.ModelSpace.AddLine(SP, EP)
'lay doi xung tu L-2,3,4,5,7,8,9,10,11,12,13,14,15 qua truc y
SP = Gocve: EP = Gocve: EP(1) = EP(1) + 100
L(2).Mirror SP, EP: L(3).Mirror SP, EP: L(4).Mirror SP, EP: L(5).Mirror SP, EP: L(7).Mirror SP, EP
L(8).Mirror SP, EP: L(9).Mirror SP, EP: L(10).Mirror SP, EP: L(11).Mirror SP, EP: L(12).Mirror SP, EP
L(13).Mirror SP, EP: L(14).Mirror SP, EP: L(15).Mirror SP, EP
'ghi kich thuoc
ThisDrawing.ActiveLayer = ThisDrawing.Layers("Kichthuoc")
Dim Vitri As Variant 'diem dat kich thuoc
'kt1
SP = L(1).StartPoint: EP = SP: EP(0) = EP(0) + Cau.b1
Vitri = SP: Vitri(1) = SP(1) + kcDim
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, 0
'kt2
SP = L(1).StartPoint: EP = L(2).EndPoint
Vitri = EP: Vitri(0) = Vitri(0) - kcDim
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, -pi / 2
'kt3
SP = L(2).EndPoint: EP = L(4).EndPoint
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, -pi / 2
'kt4
SP = L(4).EndPoint: EP = L(5).EndPoint
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, -pi / 2
'kt5
SP = L(5).EndPoint: EP = L(7).EndPoint
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, -pi / 2
'kt6
SP = L(9).StartPoint: EP = L(9).EndPoint
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, -pi / 2
'kt7
SP = L(11).StartPoint: EP = L(11).EndPoint
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, -pi / 2
'kt8
SP = L(3).StartPoint: EP = L(3).EndPoint
Vitri = SP: Vitri(1) = SP(1) + Cau.h1 / 2
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, 0
'kt9
SP = L(3).EndPoint: EP = L(5).EndPoint
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, 0
'kt10
SP = L(6).EndPoint
ThisDrawing.ModelSpace.AddDimRotated SP, EP, Vitri, 0
End Sub

Public Sub Project4()
Dim Cau As Chuongtrinh.D_Cau
Dim goc As Variant
Dim diembatdau As Variant
Dim appex As Excel.Application
Set appex = New Excel.Application
appex.Visible = False
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Set WB = appex.Workbooks.Open("E:whiterose232.xlsx")
Set WS = WB.Worksheets(1)
diembatdau = ThisDrawing.Utility.GetPoint(, "please choose the start point")
Dim i As Integer
i = 2

Do Until WS.Cells(i, 1).Value = ""
goc = diembatdau
goc(0) = goc(0) + 500 * (i - 2)
Cau.b1 = WS.Cells(i, 1).Value
Cau.b2 = WS.Cells(i, 2).Value
Cau.b3 = WS.Cells(i, 3).Value
Cau.b4 = WS.Cells(i, 4).Value
Cau.b5 = WS.Cells(i, 5).Value
Cau.b6 = WS.Cells(i, 6).Value
Cau.h1 = WS.Cells(i, 7).Value
Cau.h2 = WS.Cells(i, 8).Value
Cau.h3 = WS.Cells(i, 9).Value
Cau.h4 = WS.Cells(i, 10).Value
Cau.h5 = WS.Cells(i, 11).Value
Cau.h6 = WS.Cells(i, 12).Value

Chuongtrinh.veDcau Cau, goc
i = i + 1
Loop
End Sub

 

[whiterose232]

Mình cũng mới học VBA nên có chỗ nào làm chưa hay hoặc có cách nào hay hơn mong các bạn góp ý nhé!!

 

[PhanTuHuong]

Bạn nên sử dụng With... End With với đối tượng ThisDrawing.ModelSpace (và 1 số đối tượng hay làm việc) sẽ làm code gọn, chương trình chạy nhanh hơn.

 

[khoavu87]

Với dạng vẽ mc dầm này mình nghĩ nên khởi gán các giá trị kích thước ban đầu cho mặt cắt nữa thì tốt hơn.