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

[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:

[NguyenNgocSon 43]

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

[NguyenNgocSon 43]

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

[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!

[nguyendan81985 3]

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.