Đến nội dung


Hình ảnh
- - - - -

[Hỏi] Tìm giao điểm VBA


  • Please log in to reply
4 replies to this topic

#1 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 11 April 2015 - 11:40 PM

Sub Inter_Point1()
'On Error Resume Next
Dim TapDT As AcadSelectionSet
Dim ftype(1) As Integer, fdata(1)
ftype(0) = 0: fdata(0) = "POLYLINE"
ftype(1) = 8: fdata(1) = "PLINETNTN"
Set TapDT = CreateSelectionSet("Giaodiemzzz")
TapDT.Select acSelectionSetAll, , , ftype, fdata
Dim PL As AcadEntity
Dim Duongdan As AcadEntity
Dim pick As Variant
ThisDrawing.Utility.GetEntity Duongdan, pick, vbCrLf & "Chon duong LWPolyline tim tuyen1"
Dim pt As Variant, i As Integer
For i = 0 To TapDT.Count - 1
pt = Duongdan.IntersectWith(TapDT.Item(i), 0)
Next i
Dim c As AcadCircle
Set c = ThisDrawing.ModelSpace.AddCircle(pt, 1)
End Sub
Muc đích là tìm giao điểm của 1 đối tượng với tập đối tượng chọn
Khi sử dụng hàm trên báo lỗi
incorrect number of elements in safearray ????
Mặc dù cú pháp không hề sai.
  • 0

#2 dinhvantrang

dinhvantrang

    biết lệnh copy

  • Members
  • PipPipPip
  • 117 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 20 April 2015 - 09:23 PM

Bạn chọn đối tượng ok chứ? Theo như bộ lọc của bạn thì bạn sẽ chọn đối tượng là Polyline thuộc layer "PLINETNTN" đúng ko nhỉ?


  • 0

Thanks and Best Regards

Skype : dinhvantrang73


#3 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 21 April 2015 - 10:14 AM

Bạn chọn đối tượng ok chứ? Theo như bộ lọc của bạn thì bạn sẽ chọn đối tượng là Polyline thuộc layer "PLINETNTN" đúng ko nhỉ?

Mình chọn đối tuờn riêng lẻ bằng pick là ok, nhưng đưa vào bộ lọc bị lỗi :(


  • 0

#4 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 21 April 2015 - 10:59 AM

Code trên sai ở chỗ nếu không có giao điểm của đối tượng cuối cùng trong TapDT với đường dẫn thì pt=nil

Bạn xử lý tiếp cho trường hợp có nhiều giao điểm

...
Dim c As AcadCircle
Dim pt As Variant, i As Integer
For i = 0 To TapDT.Count - 1
pt = Duongdan.IntersectWith(TapDT.Item(i), 0)
If UBound(pt) = 2 Then
Set c = ThisDrawing.ModelSpace.AddCircle(pt, 1)
End If
Next i
...

  • 1

#5 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 24 April 2015 - 09:08 AM

Bạn chỉnh code lại như sau

 

For i = 0 To TapDT.Count - 1

pt=nothing
pt = Duongdan.IntersectWith(TapDT.Item(i), 0)

 

--> pt là mảng giao với 1 đối tượng, còn pt1 là toàn bộ các điểm giao

--> copy các phần tử trong mảng pt sang mảng pt1
Next i


  • 1
Clear sky!

MF Rock collection.