Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
16 replies to this topic

#1 Whiterose232

Whiterose232

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 17 March 2012 - 10:04 PM

Đâ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 của mình theo link này http://www.giaiphape....d-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
  • 1

#2 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 17 March 2012 - 11:15 PM

Cái này bạn nên đặt đường dẫn động.
Open("E:whiterose232.xlsx")
  • 0

#3 Whiterose232

Whiterose232

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 19 March 2012 - 01:09 PM

Trong quá ttrình copy paste bài này của mình, mình lỡ làm mất một ký tự trong bài viết. nguyên bản là E:\whiterose232.xlsx chứ không phảiE:whiterose232.xlsx. ^_^
  • 0

#4 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 21 March 2012 - 02:12 PM

Code để tạo ra đường dẫn động chứ không phải mặc định như là: E:\whiterose232.xlsx

Public Sub OpenFile()
'sample to show how to use FileDialogs
Dim objFile As FileDialogs
Dim strFilter As String
Dim strFileName As String
Set objFile = New FileDialogs
'desc,filter combinations must all be separated with pipe char "|"
' strFilter = "All Files (*.*)|*.*|Drawings (*.dwg)|*.dwg"
strFilter = "Excel 2007 (*.xlsx)|*.xlsx|Excel 2003 (*.xls)|*.xls"
objFile.OwnerHwnd = ThisDrawing.HWnd 'bind the dialog to the window
objFile.Title = "Open a File Excel-NguyenNgocSon"
'default dir is CurDir
objFile.StartInDir = "c:\"
objFile.Filter = strFilter
'return a valid filename
strFileName = objFile.ShowOpen
If Not strFileName = vbNullString Then
'use this space to perform operation
MsgBoxUni UNC("B¹n chän file d÷ liÖu: ") & strFileName, vbOKOnly, UNC("Design by NguyÔn Ngäc S¬n")
End If
Tenfile = strFileName
Set objFile = Nothing
End Sub

  • 2

#5 thanhdv8291

thanhdv8291

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 24 March 2012 - 01:57 PM

Anh cho em hỏi: Khi em viết code chương trình vẽ mặt cắt chữ T xong, lúc chạy thử chương trình thì máy báo là:
Runtime error
Automation error
The object invoked has disconected from it clients
Chương trình ko thể chạy được.
Vậy lỗi trên là lỗi gì và khắc phục nó như thế nào?
Mong anh giúp đỡ, Em rất cám ơn.
  • 0

#6 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 24 March 2012 - 02:23 PM

Vấn đề này bạn nên đưa code lên, hoặc chương trình cụ thể? Sẽ có nhiều người giúp bạn !
Mình chưa gặp lỗi đó bao giờ. Nhưng nhìn qua cái lỗi của bạn có lẽ do không tìm thấy thư viện tham chiếu, hoặc code lỗi
Thân !
  • 0

#7 thanhdv8291

thanhdv8291

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 25 March 2012 - 09:34 AM

Em cám ơn. Em sẽ xem lại Code. nếu vẫn không được em sẽ post code lên nhờ các anh xem hộ cho em.Thank!
  • 0

#8 thanhdv8291

thanhdv8291

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 25 March 2012 - 01:42 PM

Nhờ các anh giúp đỡ. Đây là code em viết. Cứ chạy là máy báo lỗi.
Code bên Userform
Private Sub CmdVematcat_Click()
Dim matcat As Chuongtrinh.Coc
matcat.a1 = Txta1.Value
matcat.b1 = Txtb1.Value
matcat.a2 = Txta2.Value
matcat.b2 = Txtb2.Value
matcat.R = TxtR.Value

Chuongtrinh.kt = Txtkt.Value

Cuasochinh.Hide
Dim Diemchon As Variant
ThisDrawing.Utility.Prompt "Chon Diem Bat Dau Ve: "
Diemchon = ThisDrawing.Utility.GetPoint()

Chuongtrinh.Vehinh matcat, Diemchon

End Sub

Code bên Module:

Option Explicit

Public Type Coc
a1 As Double
b1 As Double
a2 As Double
b2 As Double
R As Double
End Type

Public Const pi = 3.14159265358979
Public kt As Double

Public Sub Vehinh(matcat As Coc, Diemve As Variant)
Diemchon = Diemve

Dim L(1 To 2) As AcadLine
Dim sp As Variant, ep As Variant

ThisDrawing.ActiveLayer = ThisDrawing.ActiveLayers("Netdam")

sp = Diemve
ep = sp: ep(0) = ep(0) + matcat.a1
Set L(1) = ThisDrawing.ModelSpace.AddLine(sp, ep)

ep = sp
ep(1) = ep(1) - matcat.b1
Set L(2) = ThisDrawing.ModelSpace.AddLine(sp, ep)

Dim center As Variant
Dim Ac As AcadArc
Dim i As Long, j As Long

Diemve(0) = Diemve(0) + (matcat.a1 - 2 * matcat.a2) / 2
Diemve(1) = Diemve(1) - (matcat.b1 - matcat.b2) / 2

For i = 1 To 3
For j = 1 To 2
center(0) = Diemve(0) + (i - 1) * matcat.a2
center(1) = Diemve(1) - (j - 1) * matcat.b2

Set Ac = ThisDrawing.ModelSpace.AddArc(center, matcat.R)
Next
Next

sp = Diemve: sp(0) = sp(0) + matcat.a1 / 2
ep = sp: ep(1) = ep(1) + 100
L(2).Mirror sp, ep

sp = Diemve: sp(1) = sp(1) - matcat.b1 / 2
ep = sp: ep(0) = ep(0) + 100
L(1).Mirror sp, ep

ThisDrawing.ActiveLayer = ThisDrawing.ActiveLayers("Kichthuoc")
Dim vitri As Variant

sp = Diemve: ep = L(1).EndPoint
vitri = sp: vitri(1) = vitri(1) + kt
ThisDrawing.ModelSpace.AddDimRotated sp, ep, vitri, 0

sp = L(1).EndPoint
ep = sp: ep(1) = ep(1) - matcat.b1
vitri = ep: vitri(0) = vitri(0) + kt
ThisDrawing.ModelSpace.AddDimRotated sp, ep, vitri, pi / 2

sp = Ac.center: sp(0) = sp(0) - Ac.Radius
ThisDrawing.ModelSpace.AddDimRotated Ac.Radius, sp, Ac.center


End Sub
Rất mong các anh giúp em. Em cám ơn rất nhiều.Đây là file chương trình: http://www.cadviet.c...1_thanhhehe.rar
  • 1

#9 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 25 March 2012 - 03:10 PM

Mình xem qua code có lẽ nên chia làm 3 hàm thì đơn giản hơn?
1.Hàm vẽ mặt bằng móng (HCN)
2.Hàm vẽ mặt bằng cọc (hình tròn)
3.Hàm ghi kích thước
Cách gọi hàm sai: Call Chuongtrinh.Vehinh(matcat, diemchon)
Mới check qua, bạn xem thử
Thân !
  • 1

#10 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 25 March 2012 - 04:31 PM

Mình code lại cho bạn theo hướng tạo các Module con như sau:
Code bên Module:

Option Explicit
Public Type Coc
a1 As Double
b1 As Double
a2 As Double
b2 As Double
R As Double
End Type
Public Const pi = 3.14159265358979
Public kt As Double
Public Sub HCN(diemve As Variant, a As Double, b As Double)
Dim Rectang(0 To 7) As Double
Dim Pline As AcadLWPolyline
Dim BasePoint As Variant
'BasePoint = ThisDrawing.Utility.GetPoint(, vbCrLf & "Diem chen:")
BasePoint = diemve
Rectang(0) = BasePoint(0)
Rectang(1) = BasePoint(1)
Rectang(2) = BasePoint(0)
Rectang(3) = BasePoint(1) + b
Rectang(4) = BasePoint(0) + a
Rectang(5) = BasePoint(1) + b
Rectang(6) = BasePoint(0) + a
Rectang(7) = BasePoint(1)
Set Pline = ThisDrawing.ModelSpace.AddLightWeightPolyline(Rectang)
Pline.Closed = True
End Sub
Public Sub Hinhtron(tam As Variant, BK As Double)
Dim DT As AcadCircle
Set DT = ThisDrawing.ModelSpace.AddCircle(tam, BK)
End Sub
Code bên Userform

Private Sub CmdVematcat_Click()
Dim mep1, mep2 As Double
Dim i, j As Integer
Dim toado(2) As Double
Dim center(2) As Double
Dim matcat As Coc
With matcat
.a1 = Val(Txta1)
.b1 = Val(Txtb1)
.a2 = Val(Txta2)
.b2 = Val(Txtb2)
.R = Val(TxtR)
'Chuongtrinh.kt = Txtkt.Value
Cuasochinh.Hide
Dim diemchon As Variant
ThisDrawing.Utility.Prompt "Chon Diem Bat Dau Ve: "
diemchon = ThisDrawing.Utility.GetPoint()
Call HCN(diemchon, .a1, .b1)
mep1 = (.a1 - 2 * .a2) / 2
mep2 = (.b1 - .b2) / 2
toado(0) = diemchon(0) + mep1: toado(1) = diemchon(1) + mep2: toado(2) = diemchon(2)
'Call Hinhtron(toado, .R)
For i = 1 To 3
For j = 1 To 2
center(0) = toado(0) + (i - 1) * .a2
center(1) = toado(1) + (j - 1) * .b2
Call Hinhtron(center, .R)
Next j
Next i
End With
End Sub
Theo mình bạn nên tổng quát khi móng cọc gồm m hãng n cột như vậy sẽ đầy đủ hơn cho trường hợp i,j.
Phần ghi kích thước bạn nên tự làm
Thân!
Chúc bạn học tốt.http://www.cadviet.c.../48467_code.rar
  • 1

#11 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 26 March 2012 - 12:47 PM

Thêm trường hợp trong móng gồm m hàng , n cột
http://www.cadviet.c.../3/48467_vb.rar
  • 1

#12 thanhdv8291

thanhdv8291

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 28 March 2012 - 10:58 PM

Em cám ơn anh rất nhiều ạ.hi.
  • 0

#13 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 28 March 2012 - 11:27 PM

Chắc bạn là dân cầu đường.:D.
Theo mình không nên nhập thông số bề rộng móng mà nên nhập khoảng cách tim cọc, khoảng cách đến mép bệ => tự tính toán ra chiều rộng bệ móng sẽ hợp lý và hay hơn!
Thân!
  • 0

#14 poseidon_hh

poseidon_hh

    biết pan

  • Members
  • Pip
  • 9 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 02 April 2012 - 07:23 PM

e mới học lập trình không biết lệnh này viết sai ở chỗ nào.
mấy a xem hộ e với, sửa hộ e thì càng tốt
thân!!


private Sub CommandButton3_Click()
Dim lineobj As AcadLine
Dim startpoint(0 To 2) As Double
Dim endpoint(0 To 2) As Double
Dim objent As AcadArc
Dim center(0 To 2) As Double
Dim startangle As Double
Dim endangle As Double
startpoint(0) = 2: startpoint(1) = 1: startpoint(2) = 0
endpoint(0) = 4: endpoint(1) = 1: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
startpoint(0) = 5: startpoint(1) = 2: startpoint(2) = 0
endpoint(0) = 5: endpoint(1) = 3: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
startpoint(0) = 4: startpoint(1) = 4: startpoint(2) = 0
endpoint(0) = 2: endpoint(1) = 4: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
startpoint(0) = 1: startpoint(1) = 3: startpoint(2) = 0
endpoint(0) = 1: endpoint(1) = 2: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
center(0) = 2: center(1) = 2: center(2) = 0
startangle = 180 * 3.141592654 / 180
endangle = 270 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
center(0) = 2: center(1) = 3: center(2) = 0
startangle = 90 * 3.141592654 / 180
endangle = 180 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
center(0) = 4: center(1) = 3: center(2) = 0
startangle = 0 * 3.141592654 / 180
endangle = 90 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
center(0) = 4: center(1) = 2: center(2) = 0
startangle = 270 * 3.141592654 / 180
endangle = 360 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)


' Xác d?nh tr?c d?i x?ng
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 6: point1(1) = 1: point1(2) = 0
point2(0) = 6: point2(1) = 4: point2(2) = 0
MsgBox "L?y d?i x?ng du?ng da tuy?n.", , "VD Mirror"
' Th?c hi?n l?y d?i x?ng du?ng da tuy?n
Dim mirrorObj As AcadLWPolyline
Set mirrorObj = plineObj.Mirror(point1, point2)
mirrorObj.color = acRed
ZoomAll
MsgBox "Mirror completed.", , " VD Mirror"
End Sub
  • 0

#15 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 02 April 2012 - 09:57 PM

Thật là khó với code như này
Nhưng bạn sai ở chỗ:

Set mirrorObj = plineObj.Mirror(point1, point2)
nghĩa là bạn chưa tạo được đối tượng plineObj nên không có thực thể đối xưng => báo sai.
Nếu bạn muốn lấy đối xứng cho toàn bộ khối trên thì đối tượng khai báo phải là kiểu AcadLine hoặc Variant
Dim mirrorObj As AcadLine
Dim mirrorObj As Variant
  • 0

#16 poseidon_hh

poseidon_hh

    biết pan

  • Members
  • Pip
  • 9 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 05 April 2012 - 03:33 PM

anh ơi cho em hỏi code này sai ở chỗ nào ạ
thân!



Private Sub CommandButton1_Click()

Dim lineobj As AcadLine
Dim startpoint(0 To 2) As Double
Dim endpoint(0 To 2) As Double
Dim dblRadius As Double
Dim center(0 To 2) As Double
Dim startangle As Double
Dim endangle As Double

startpoint(0) = 2: startpoint(1) = 1: startpoint(2) = 0
endpoint(0) = 4: endpoint(1) = 1: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

center(0) = 2: center(1) = 2: center(2) = 0
startangle = 180 * 3.141592654 / 180
endangle = 270 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)

startpoint(0) = 5: startpoint(1) = 2: startpoint(2) = 0
endpoint(0) = 5: endpoint(1) = 3: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

center(0) = 2: center(1) = 3: center(2) = 0
startangle = 90 * 3.141592654 / 180
endangle = 180 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)

startpoint(0) = 4: startpoint(1) = 4: startpoint(2) = 0
endpoint(0) = 2: endpoint(1) = 4: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

startpoint(0) = 1: startpoint(1) = 3: startpoint(2) = 0
endpoint(0) = 1: endpoint(1) = 2: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

center(0) = 4: center(1) = 3: center(2) = 0
startangle = 0 * 3.141592654 / 180
endangle = 90 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)

center(0) = 4: center(1) = 2: center(2) = 0
startangle = 270 * 3.141592654 / 180
endangle = 360 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)


Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
patternName = "ANSI31"
PatternType = 0
bAssociativity = True


Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
Dim outerloop(0 To 7) As AcadEntity

startpoint(0) = 2: startpoint(1) = 1: startpoint(2) = 0
endpoint(0) = 4: endpoint(1) = 1: endpoint(2) = 0
Set outerloop(0) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
hatchObj.AppendOuterLoop (outerloop)


startpoint(0) = 5: startpoint(1) = 2: startpoint(2) = 0
endpoint(0) = 5: endpoint(1) = 3: endpoint(2) = 0
Set outerloop(1) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
hatchObj.AppendOuterLoop (outerloop)

startpoint(0) = 4: startpoint(1) = 4: startpoint(2) = 0
endpoint(0) = 2: endpoint(1) = 4: endpoint(2) = 0
Set outerloop(2) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
hatchObj.AppendOuterLoop (outerloop)

startpoint(0) = 1: startpoint(1) = 3: startpoint(2) = 0
endpoint(0) = 1: endpoint(1) = 2: endpoint(2) = 0
Set outerloop(3) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
hatchObj.AppendOuterLoop (outerloop)

center(0) = 2: center(1) = 3: center(2) = 0
startangle = 90 * 3.141592654 / 180
endangle = 180 * 3.141592654 / 180
dblRadius = 1
Set outerloop(4) = ThisDrawing.ModelSpace.AcadArc(center, dblRadius, endangle, startangle)
hatchObj.AppendOuterLoop (outerloop)

center(0) = 2: center(1) = 2: center(2) = 0
startangle = 180 * 3.141592654 / 180
endangle = 270 * 3.141592654 / 180
dblRadius = 1
Set outerloop(5) = ThisDrawing.ModelSpace.AcadArc(center, startangle, endangle, dblRadius)
hatchObj.AppendOuterLoop (outerloop)


center(0) = 4: center(1) = 3: center(2) = 0
startangle = 0 * 3.141592654 / 180
endangle = 90 * 3.141592654 / 180
dblRadius = 1
Set outerloop(6) = ThisDrawing.ModelSpace.AcadArc(center, dblRadius, endangle, startangle)
hatchObj.AppendOuterLoop (outerloop)

center(0) = 4: center(1) = 2: center(2) = 0
startangle = 270 * 3.141592654 / 180
endangle = 360 * 3.141592654 / 180
dblRadius = 1
Set outerloop(7) = ThisDrawing.ModelSpace.AcadArc(center, dblRadius, endangle, startangle)
hatchObj.AppendOuterLoop (outerloop)

hatchObj.Evaluate
hatchObj.PatternSpace = hatchObj.PatternSpace

hatchObj.Evaluate
ThisDrawing.Regen True


End Sub
  • 0

#17 phongvu199x

phongvu199x

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 January 2015 - 12:35 AM

Ai có thể giúp em 1 bài tương tự thế này không ạ? Em đang cần gấp ạ


  • 0