Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
ALPHAA

Vấn đề Hatch bằng VBA trong CAD vật thể gồm nhiều đối tượng

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

ALPHAA    0

Kính gởi các cao thủ trong forum!
Mình cũng mới chập chững tìm hiểu về VBA trong CAD nhưng hiện tại mình bị đứng lại ở chổ Hatch vật thể như sau:
 Khi mình vẽ một vật thể trong đó chỉ có một loại đối tượng, cụ thể như hình chữ nhật  (chỉ gồm Line, polyline....) thì khi addHatch thì vẫn bình thường không sao
+ Nhưng khi mình tạo một vật thể bao gồm cả Line và Arc thì lại không addHatch được, trong khi Hatch bằng tay ngoài môi trường Cad thì bình thường
Mong các cao thủ giải đáp cho mình với!
- Code của mình tận dụng từ file của anh PTH:
 
Sub Example_AppendInnerLoop()
' This example creates an associative hatch in model space.

Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim DiemP(0 To 2) As Double
Dim Diem1(0 To 2) As Double
Dim Diem2(0 To 2) As Double
Dim Diem3(0 To 2) As Double
Dim Diem4(0 To 2) As Double
Dim Diem5(0 To 2) As Double
Dim Diem6(0 To 2) As Double

' Define the hatch
patternName = "ANSI31"
PatternType = 0
bAssociativity = True

' Create the associative Hatch object
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)

' Create the outer loop for the hatch.
' An arc and a line are used to create a closed loop.

Dim outerLoop(0 To 5) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
center(0) = 5: center(1) = 3: center(2) = 0
DiemP(0) = 2.5: DiemP(1) = 3.5
radius = 3
startAngle = 0
endAngle = 3.141592
Diem1(0) = center(0) - 3: Diem1(1) = center(1)
Diem2(0) = Diem1(0) - 3: Diem2(1) = Diem1(1)
Diem3(0) = Diem2(0): Diem3(1) = Diem2(1) + 5
Diem4(0) = Diem3(0) + 12: Diem4(1) = Diem3(1)
Diem5(0) = Diem4(0): Diem5(1) = center(1)
Diem6(0) = center(0) + 3: Diem6(1) = center(1)
Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(Diem1, Diem2)
Set outerLoop(2) = ThisDrawing.ModelSpace.AddLine(Diem2, Diem3)
Set outerLoop(3) = ThisDrawing.ModelSpace.AddLine(Diem3, Diem4)
Set outerLoop(4) = ThisDrawing.ModelSpace.AddLine(Diem4, Diem5)
Set outerLoop(5) = ThisDrawing.ModelSpace.AddLine(Diem5, Diem6)

'Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).StartPoint, outerLoop(0).EndPoint)
ThisDrawing.Regen True

' Append the outer loop to the hatch object
hatchObj.AppendOuterLoop (outerLoop)

' Append a circle as the inner loop for the hatch.
Dim innerLoop(0) As AcadEntity
Dim innerLoop1(0) As AcadEntity
center(0) = 5: center(1) = 4.5: center(2) = 0
radius = 1
Set innerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
Set innerLoop1(0) = ThisDrawing.ModelSpace.AddText("PTH", DiemP, 0.2)
hatchObj.AppendInnerLoop (innerLoop)
hatchObj.AppendInnerLoop (innerLoop1)

' Evaluate and display the hatch
hatchObj.Evaluate
ThisDrawing.Regen True

End Sub

- Hình vật thể mình cần hatch:

90148_hatch.jpg

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

Chào bạn. Mình đã xem qua, về cơ bản tất cả đều đúng

Mình tìm ra lỗi sai, đúng như dự đoán là do làm tròn số trong Cad, nên số endAngle = 3.141592 không bằng giá trị pi thực tế

Bạn thay endAngle = 3.141592 bằng endAngle = 3.141592654

Chạy thử code => Ok

  • Vote tăng 1

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

Hoặc bạn có thể không cần sửa số như trên nhưng thay vào đó tọa độ, góc của arc sẽ phải được nội suy từ các line mà bạn tạo ra. Như vậy sẽ khắc phục lỗi tròn số.

Thân ái

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
ALPHAA    0

Cảm ơn anh NguyenNgocSon rất nhiều! Mong anh và các cao thủ giúp đỡ nhiều về sau! Hồi trước giờ chỉ toàn là sử dụng VBA trong Ễcl không ah! Bữa giờ tập tành qua bên Cad nên cũng hơi sượng! hihihi!

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

hi, mình thì mới tập tành VBA trong CAD. các bro chỉ giúp mình thế này nhé: mình muốn vẽ 1 hình tam giác với tọa độ là 1 biến. sau đó hatch cái hình tam giác này.

hình tam giác này có thể dùng polygon để vẽ (lệnh này mình chưa biết) hoặc dùng line (phần này mình vẽ đc rồi)

 

bro nào biết chỉ giúp nhé. thanks.

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  

×