Learning English

Study English - IELTS Preparation - Australia Network

Autocad & VBA

'Trong AutoCad
Public ExcelApp As Excel.Application
Public Const Tenfile = "D:\Khoahoc2008\Hinhtru.xls"

Sub VeHinhTru_AutoCad()
Dim i As Integer
Dim AcadMo As AcadModelSpace
Dim AcadUt As AcadUtility
Dim DiemDauP As Variant 'Diem dau tien de ve
Dim DiemBaoP(0 To 11) As Double 'Diem bao phan to mat cat
'Khai bao ghi ky hieu Ten lop
Dim GhiTenlopP(0 To 2) As Double
Dim Tenlop As String
Dim TenlopT As AcadText
'Khai bao ghi do sau lop
Dim GhiDosauP(0 To 2) As Double
Dim DosauT As AcadText
'Khai bao To mat cat
Dim MatcatH As AcadHatch
Dim VongbaoPL(0) As AcadPolyline
'Khai bao noi dung Hinh tru
Dim HinhTruP(0 To 2) As Double
Dim HinhTruT As AcadText
'Khai bao ty le dung Hinh tru
Dim TLdung As Single
Dim TLdungP(0 To 2) As Double
Dim TLdungT As AcadText
'Khai bao chieu rong cua phan To ky hieu dia tang va Pi
Const Chieurong = 10: Const Pi = 3.14159
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Khoi dong Excel
Call KhoidongExcel
TLdung = Val(ExcelApp.Sheets("Khai bao").Range("J3"))
'Thiet lap font ".VnArial" cho kieu "Standard"
Set TxtStyleObj = ActiveDocument.TextStyles.Item("Standard")
TxtStyleObj.SetFont ".VnArial", False, False, 0, 34
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set AcadMo = ActiveDocument.ModelSpace
Set AcadUt = ActiveDocument.Utility
DiemDauP = AcadUt.GetPoint(, "Vao vi tri dau tien:")
'Ghi noi dung ten Hinh tru va Ty le dung
HinhTruP(0) = DiemDauP(0) + 8
HinhTruP(1) = DiemDauP(1) + 4
Set HinhTruT = AcadMo.AddText("HINH TRU HO KHOAN", HinhTruP, 1.5)
TLdungP(0) = HinhTruP(0) + 5
TLdungP(1) = HinhTruP(1) - 2.5
Set TLdungT = AcadMo.AddText("Tû lÖ ®øng: 1/" & TLdung, TLdungP, 1)
TLdungT.ObliqueAngle = 0.15
DiemBaoP(0) = DiemDauP(0)
DiemBaoP(1) = DiemDauP(1)

With ExcelApp.Worksheets("Khai bao").Range("B2")

'Tao vong lap qua tung diem
i = 1
Do
'Xac dinh do chenh sau giua cac lop dat
Chenhsau = (.Offset(i - 1, 1) - .Offset(i, 1)) * 1000 / TLdung
'Xac dinh cac diem bao va ve duong Polyline
DiemBaoP(3) = DiemBaoP(0) + Chieurong: DiemBaoP(4) = DiemBaoP(1)
DiemBaoP(6) = DiemBaoP(3): DiemBaoP(7) = DiemBaoP(4) + Chenhsau
DiemBaoP(9) = DiemBaoP(6) - Chieurong: DiemBaoP(10) = DiemBaoP(7)
Set VongbaoPL(0) = AcadMo.AddPolyline(DiemBaoP)
VongbaoPL(0).Closed = True 'Kep kin duong Polyline
VongbaoPL(0).color = acRed
'Ghi ten cac lop dat
GhiTenlopP(0) = DiemBaoP(3) + 2
GhiTenlopP(1) = DiemBaoP(4) + Chenhsau / 2
Tenlop = "Líp " & .Offset(i, 0) & ": " & .Offset(i, 2)
Set TenlopT = AcadMo.AddText(Tenlop, GhiTenlopP, 0.8)
'Ghi do sau lop
GhiDosauP(0) = DiemBaoP(6) + 0.5
GhiDosauP(1) = DiemBaoP(7)
Set DosauT = AcadMo.AddText(FormatNumber(.Offset(i, 1), 1), GhiDosauP, 1)
DosauT.color = acRed
'To ky hieu mat cat dia tang
Set MatcatH = AcadMo.AddHatch(1, .Offset(i, 4), True)
MatcatH.PatternScale = .Offset(i, 5)
MatcatH.PatternAngle = .Offset(i, 6) * Pi / 180
MatcatH.AppendOuterLoop (VongbaoPL)
MatcatH.Evaluate: MatcatH.Update
'Gan diem de sang lop moi
DiemBaoP(0) = DiemBaoP(9)
DiemBaoP(1) = DiemBaoP(10)

i = i + 1
Loop Until IsEmpty(.Offset(i, 0))
End With
ZoomAll
Xoa bo bien doi tuong
Set ExcelApp = Nothing
Set AcadMo = Nothing
Set AcadUt = Nothing

End Sub
'Lay so lieu tu xecel

Sub openexcel(ByVal tenfile As String)
On Error Resume Next
Set excelapp = GetObject(, "Excel.application")
If Err Then
Err.Clear
Set acadapp = CreateObject("Excel.application")
End If
excelapp.Visible = True
excelapp.Workbooks.Open (tenfile)
AppActivate AutoCAD.Caption
End Sub
Sub venuoi()
' This example creates a 4 X 4 polygonmesh in model space.
Dim meshObj As AcadPolygonMesh
Dim mSize, nSize, count As Integer
Dim points(0 To 47) As Double

mSize = 4: nSize = 4
' Create the matrix of points
points(0) = 0: points(1) = 0: points(2) = 0
points(3) = 2: points(4) = 0: points(5) = 1
points(6) = 4: points(7) = 0: points(8) = 0
points(9) = 6: points(10) = 0: points(11) = 1
points(12) = 0: points(13) = 2: points(14) = 0
points(15) = 2: points(16) = 2: points(17) = 1
points(18) = 4: points(19) = 2: points(20) = 0
points(21) = 6: points(22) = 2: points(23) = 1
points(24) = 0: points(25) = 4: points(26) = 0
points(27) = 2: points(28) = 4: points(29) = 1
points(30) = 4: points(31) = 4: points(32) = 0
points(33) = 6: points(34) = 4: points(35) = 0
points(36) = 0: points(37) = 6: points(38) = 0
points(39) = 2: points(40) = 6: points(41) = 1
points(42) = 4: points(43) = 6: points(44) = 0
points(45) = 6: points(46) = 6: points(47) = 0



' creates a 3Dmesh in model space
Set meshObj = ThisDrawing.ModelSpace.Add3DMesh(mSize, nSize, points)
' Change the viewing direction of the viewport to better see the cylinder
ZoomAll

End Sub


Quy Chế 43

Khoa đóng tàu bắt đầu đào tạo theo tiến chỉ bắt đầu từ khoá 49. Bạn nào quan tâm đến quy chế này thì liên Hệ với mình theo đia chỉ phamdinhba007@gmail.com để có được nội dung cụ thể của quy chế này.