Đến nội dung


Hình ảnh
- - - - -

Break at point bằng VBA


  • Please log in to reply
6 replies to this topic

#1 ks_chang

ks_chang

    biết vẽ line

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

Đã gửi 12 October 2010 - 02:30 PM

Mình có một loạt những Polyline giao nhau, mình muốn break các Pline này tại những chỗ giao nhau bằng đoạn code dứơi. Nếu chọn một vài Polyline thì đuợc, nhưng nếu quét hết toàn bộ thì bị lỗi xẩy ra (như nó bị gãy ko dúng nút giao...), mọi ngừơi xem hộ mình cái lỗi ở đâu với. Thanks!

Sub Break_Polyline_1point()
'Chon doi tuong Polyline
Dim objEnt As AcadSelectionSet
On Error Resume Next
Set objEnt = ThisDrawing.SelectionSets("SSET")
objEnt.Delete
Set objEnt = ThisDrawing.SelectionSets.Add("SSET")
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0: dataValue(0) = "LWPolyline"
objEnt.SelectOnScreen gpCode, dataValue
Dim ent As AcadEntity
'Vong lap cac PL
Dim n As Long
n = objEnt.Count

For Each ent In objEnt
Dim i As Integer
Dim L As Double
L = ent.Length
For i = 0 To n - 1
ReDim oent1(i) As AcadEntity
Set oent1(i) = objEnt.Item(i)
If L <> oent1(i).Length Then
Dim fpt As Variant
fpt = ent.IntersectWith(oent1(i), acExtendNone)
Dim ln As AcadLWPolyline
Dim oent As AcadEntity
Set oent = ent
Set ln = oent
Dim strh As String
strh = ln.Handle
strp1 = Replace(CStr(fpt(0)), ",", ".") & "," & _
Replace(CStr(fpt(1)), ",", ".") & "," & _
Replace(CStr(fpt(2)), ",", ".")
ThisDrawing.SendCommand "_BREAK " & _
"(handent " & Chr(34) & strh & Chr(34) & ")" & _
vbCr & strp1 & vbCr & "@" & vbCr

End If
Next
Next ent
End Sub

  • 0

#2 phantuhuong

phantuhuong

    biết dimstyle

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

Đã gửi 12 October 2010 - 08:37 PM

Mình có một loạt những Polyline giao nhau, mình muốn break các Pline này tại những chỗ giao nhau bằng đoạn code dứơi. Nếu chọn một vài Polyline thì đuợc, nhưng nếu quét hết toàn bộ thì bị lỗi xẩy ra (như nó bị gãy ko dúng nút giao...), mọi ngừơi xem hộ mình cái lỗi ở đâu với. Thanks!

Sub Break_Polyline_1point()
'Chon doi tuong Polyline
Dim objEnt As AcadSelectionSet
On Error Resume Next
Set objEnt = ThisDrawing.SelectionSets("SSET")
objEnt.Delete
Set objEnt = ThisDrawing.SelectionSets.Add("SSET")
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0: dataValue(0) = "LWPolyline"
objEnt.SelectOnScreen gpCode, dataValue
Dim ent As AcadEntity
'Vong lap cac PL
Dim n As Long
n = objEnt.Count

For Each ent In objEnt
Dim i As Integer
Dim L As Double
L = ent.Length
For i = 0 To n - 1
ReDim oent1(i) As AcadEntity
Set oent1(i) = objEnt.Item(i)
If L <> oent1(i).Length Then
Dim fpt As Variant
fpt = ent.IntersectWith(oent1(i), acExtendNone)
Dim ln As AcadLWPolyline
Dim oent As AcadEntity
Set oent = ent
Set ln = oent
Dim strh As String
strh = ln.Handle
strp1 = Replace(CStr(fpt(0)), ",", ".") & "," & _
Replace(CStr(fpt(1)), ",", ".") & "," & _
Replace(CStr(fpt(2)), ",", ".")
ThisDrawing.SendCommand "_BREAK " & _
"(handent " & Chr(34) & strh & Chr(34) & ")" & _
vbCr & strp1 & vbCr & "@" & vbCr

End If
Next
Next ent
End Sub


Đoạn code này là duyệt qua toàn bộ đối tượng polyline và giao cắt giữa chúng với nhau thôi. Tuy nhiên chỉ bắt được điểm giao cắt đầu tiên, từ điểm thứ 2 là chịu. Tuy nhiên đoạn code này rất hay cho ai nghiên cứu Trim, break,... = VBA
  • 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!


#3 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 13 October 2010 - 10:34 AM

Mình có một loạt những Polyline giao nhau, mình muốn break các Pline này tại những chỗ giao nhau bằng đoạn code dứơi. Nếu chọn một vài Polyline thì đuợc, nhưng nếu quét hết toàn bộ thì bị lỗi xẩy ra (như nó bị gãy ko dúng nút giao...), mọi ngừơi xem hộ mình cái lỗi ở đâu với. Thanks!


Đầu tiên ứng với mỗi PL, tìm tất cả các điểm giao với các PL còn lại.

Từ n điểm giao, sẽ có n+1 PL mới được tạo ra.
Vì vậy cần xác định trong n điểm chạy dọc theo PL, điểm nào là đầu tiên và điểm nào là cuối cùng.

--> có n+1 đường PL mới như sau:
điểm đầu PL --> điểm giao 1
điểm giao 1 --> điểm giao 2
...
điểm giao n-1 --> điểm giao n
điểm giao n --> điểm cuối PL

Tạo xong các đường mới thì delete cái cũ
  • 0
Clear sky!

MF Rock collection.

#4 ks_chang

ks_chang

    biết vẽ line

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

Đã gửi 15 October 2010 - 08:56 AM

Đầu tiên ứng với mỗi PL, tìm tất cả các điểm giao với các PL còn lại.

Từ n điểm giao, sẽ có n+1 PL mới được tạo ra.
Vì vậy cần xác định trong n điểm chạy dọc theo PL, điểm nào là đầu tiên và điểm nào là cuối cùng.

--> có n+1 đường PL mới như sau:
điểm đầu PL --> điểm giao 1
điểm giao 1 --> điểm giao 2
...
điểm giao n-1 --> điểm giao n
điểm giao n --> điểm cuối PL

Tạo xong các đường mới thì delete cái cũ

Hi, thanks anhcos, có thể đoạn mã kia bị lỗi do khi các đối tựong PL đầu bị break, đến khi tiếp tục với PL sau thì đối tựong đầu ko còn nữa nên nó chỉ đúng với nút giao đầu tiên như phantuhuong nói. Mình dang thử cách này:
- Duyệt qua các nút giao, sau đó vẽ vòng tròn tại đó, tiếp tục select các vòng tròn tạo ra, trong mỗi vòng tròn đó lấy ra 2 điểm của hình chữ nhật bao quanh vòng tròn, sau đó select các PL thông qua 2 điểm đó, dùng đoạn code trên để break 2 PL tại nút.
  • 0

#5 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 15 October 2010 - 09:17 AM

Hi, thanks anhcos, có thể đoạn mã kia bị lỗi do khi các đối tựong PL đầu bị break, đến khi tiếp tục với PL sau thì đối tựong đầu ko còn nữa nên nó chỉ đúng với nút giao đầu tiên như phantuhuong nói. Mình dang thử cách này:
- Duyệt qua các nút giao, sau đó vẽ vòng tròn tại đó, tiếp tục select các vòng tròn tạo ra, trong mỗi vòng tròn đó lấy ra 2 điểm của hình chữ nhật bao quanh vòng tròn, sau đó select các PL thông qua 2 điểm đó, dùng đoạn code trên để break 2 PL tại nút.

Giải pháp này khả thi nhưng tốn rất nhiều chi phí. :cheers:
Gợi ý : bạn nghiên cứu thêm lệnh Break của CAD, tìm ra qui luật tạo đối tuợng mới của CAD (sau khi thực hiện lệnh Break thành công)
  • 0

#6 ks_chang

ks_chang

    biết vẽ line

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

Đã gửi 15 October 2010 - 05:27 PM

Cách của anhcos gợi ý là tạo ra các Pline mới, sau đó xóa cái cũ, tuy nhiên trong trường hợp PL ban đầu ở giữa 2 điểm gãy có các cung tròn và các điễm gãy khác thì rất khó ghép tọa độ PL mới theo mảng đựoc.
  • 0

#7 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 15 October 2010 - 09:07 PM

Cách của anhcos gợi ý là tạo ra các Pline mới, sau đó xóa cái cũ, tuy nhiên trong trường hợp PL ban đầu ở giữa 2 điểm gãy có các cung tròn và các điễm gãy khác thì rất khó ghép tọa độ PL mới theo mảng đựoc.


Đây là thuật toán, còn với acad thì mình có thể nhờ nó break dùm (cái này mình chưa thử).
Như bạn nói nếu phân đoạn PL là arc thì phức tạp hơn line, nhưng không khó quá.

Từ độ lồi (bulge) của phân đoạn trên PL --> tính được bán kính, điểm giao chắc chắn sẽ nằm giữa điểm i và i+1 của PL --> tính lại được 2 góc đã chia ra từ góc cũ --> tính được độ lồi của 2 phân góc (bằng TAN của 1/4 góc chắn) và lập ra PL mới.

Bạn thử triển khai xem như thế nào, mình sẽ cố gắng bám theo.
  • 0
Clear sky!

MF Rock collection.