Đến nội dung


Hình ảnh
- - - - -

Hỏi cách Tô Hatch bỏ qua đối tượng là block bằng VBA?


  • Please log in to reply
2 replies to this topic

#1 nvson

nvson

    biết vẽ ellipse

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

Đã gửi 18 July 2011 - 01:54 PM

Các bác cho hỏi cách "Tô Hatch bỏ qua đối tượng là block bằng VBA"
Tôi dùng đoạn code sau nhưng cứ báo lỗi, mong các bác ra tay giúp đỡ.

Public Sub To_H()
'Error Resume Next
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim outerLoop(0) As AcadEntity
Dim innerLoop(0) As AcadEntity

Dim plineObj As AcadPolyline
Dim points(0 To 11) As Double

points(0) = 0: points(1) = 0: points(2) = 0
points(3) = 15: points(4) = 0: points(5) = 0
points(6) = 15: points(7) = 6: points(8) = 0
points(9) = 0: points(10) = 6: points(11) = 0

Set plineObj = AcadApplication.ActiveDocument.ModelSpace.AddPolyline(points)
plineObj.Closed = True

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


Dim objBlock As AcadBlockReference
Dim ptB(0 To 2) As Double
ptB(0) = 5
ptB(1) = 3
Set objBlock = AutoCAD.ActiveDocument.ModelSpace.InsertBlock(ptB, "TL", "0.5", "0.5", "0.5", 0)

Dim x, varAtts
varAtts = objBlock.GetAttributes
For x = LBound(varAtts) To UBound(varAtts)
Select Case varAtts(x).TagString
Case "TEN-LOP"
varAtts(x).TextString = "1"
End Select
Next x

' Create the associative Hatch object
Set hatchObj = AcadApplication.ActiveDocument.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
Set outerLoop(0) = plineObj
hatchObj.PatternScale = 0.5
Set innerLoop(0) = objBlock

hatchObj.AppendOuterLoop (outerLoop)
hatchObj.AppendInnerLoop (innerLoop)

hatchObj.Evaluate
AcadApplication.ActiveDocument.Regen True

End Sub

đây là file dwg
Thanks!
  • 0

#2 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 July 2011 - 04:49 PM

Các bác cho hỏi cách "Tô Hatch bỏ qua đối tượng là block bằng VBA"
Tôi dùng đoạn code sau nhưng cứ báo lỗi, mong các bác ra tay giúp đỡ.


Public Sub To_H()
'Error Resume Next
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim outerLoop(0) As AcadEntity
Dim innerLoop(0) As AcadEntity

Dim plineObj As AcadPolyline
Dim points(0 To 11) As Double

points(0) = 0: points(1) = 0: points(2) = 0
points(3) = 15: points(4) = 0: points(5) = 0
points(6) = 15: points(7) = 6: points(8) = 0
points(9) = 0: points(10) = 6: points(11) = 0

Set plineObj = AcadApplication.ActiveDocument.ModelSpace.AddPolyline(points)
plineObj.Closed = True

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


Dim objBlock As AcadBlockReference
Dim ptB(0 To 2) As Double
ptB(0) = 5
ptB(1) = 3
Set objBlock = AutoCAD.ActiveDocument.ModelSpace.InsertBlock(ptB, "TL", "0.5", "0.5", "0.5", 0)

Dim x, varAtts
varAtts = objBlock.GetAttributes
For x = LBound(varAtts) To UBound(varAtts)
Select Case varAtts(x).TagString
Case "TEN-LOP"
varAtts(x).TextString = "1"
End Select
Next x

' Create the associative Hatch object
Set hatchObj = AcadApplication.ActiveDocument.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
Set outerLoop(0) = plineObj
hatchObj.PatternScale = 0.5
Set innerLoop(0) = objBlock

hatchObj.AppendOuterLoop (outerLoop)
hatchObj.AppendInnerLoop (innerLoop)

hatchObj.Evaluate
AcadApplication.ActiveDocument.Regen True

End Sub

đây là file dwg
Thanks!

Vì method AppendOuterLoop và AppendinnerLoop có đối số là các đối tượng là line, pline, spline, circle, ellipse, region nên khi bạn áp dụng đối số là block thi trương chình bị lỗi. Khắc phục: Bạn có thể add thêm circle rồi hatch.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#3 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 18 July 2011 - 05:02 PM

Đúng là nên tạo đường bao quanh Block, sau khi tô xong xoá bỏ. Đành khắc phục kiểu này vậy.


Cậu xem thêm ở đây nếu có nhiều block cần loại bỏ:

http://www.cadviet.c...showtopic=21050
  • 0
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!