Đến nội dung


Hình ảnh
- - - - -

cần hàm VBA trả Y của điểm trên polyline khi biết X


  • Please log in to reply
4 replies to this topic

#1 kysu2tung

kysu2tung

    biết pan

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

Đã gửi 29 July 2009 - 07:13 PM

Tui có một vấn đề những tưởng là đơn gián nhưng làm mãi không xong.
Tui có một đường polyline dài
Giả sử cho trước hoành độ X, làm sao để viết một function bằng VBA để trả về tung độ Y của điểm bất kỳ trên polyline nói trên
  • 0

#2 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 03 August 2009 - 09:28 AM

Tui có một vấn đề những tưởng là đơn gián nhưng làm mãi không xong.
Tui có một đường polyline dài
Giả sử cho trước hoành độ X, làm sao để viết một function bằng VBA để trả về tung độ Y của điểm bất kỳ trên polyline nói trên


VD sau đây chỉ sử dụng trong trường hợp polyline của bạn là phẳng, không phải là 3Dpolyline.
Và các đường polyline này đang nằm trong ModelSpace.

Giả sử PLObj là đối tượng polyline.

1. Tạo đối tượng LineObj nằm ngang có hoành độ X và cao độ Z = cao độ của Polyline, tung độ tùy ý.

Dim start_pt(2) as double, end_pt(2) as double

start_pt(0) = X
end_pt(0) = X

start_pt(1) = 1 'sao cũng dc
end_pt(1) = 2 '

start_pt(2) = PLObj.Elevation
end_pt(2) = PLObj.Elevation

set LineObj = ThisDrawing.ModelSpace.AddLine(start_pt,end_pt)

2. Tìm điểm giao giữa đường thẳng này và Polyline, sẽ có một or rất nhiều giao điểm.
Hàm IntersectWith trả về các giao điểm thành mảng liên tiếp các toạ độ X, Y, Z của giao điềm:
X1, Ý, Z1, X2, Y2, Z2, ... Xn, Yn, Zn

Dim giaos() as double
Set giaos = LineObj.IntersectWith (PLObj,1)'1 là tìm giao điểm khi kéo dài LineObj

3. Ờ quên mất, xóa thằng em Line đi
LineObj.Delete
  • 1
Clear sky!

MF Rock collection.

#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 04 August 2009 - 06:10 PM

Thuật toán trên cũng áp dụng cho SPLine tốt.

Dùng vẽ mặt cắt với bình đồ hay các đường đặc tính cũng được.
  • 0
Clear sky!

MF Rock collection.

#4 phantuhuong

phantuhuong

    biết dimstyle

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

Đã gửi 04 August 2009 - 06:28 PM

Tui có một vấn đề những tưởng là đơn gián nhưng làm mãi không xong.
Tui có một đường polyline dài
Giả sử cho trước hoành độ X, làm sao để viết một function bằng VBA để trả về tung độ Y của điểm bất kỳ trên polyline nói trên


Bạn tham khảo thuật toán bắt giao điểm bằng phương thức IntersectWith:

Sub Example_IntersectWith()
' This example creates a line and circle and finds the points at
' which they intersect.

' Create the line
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double
startPt(0) = 1: startPt(1) = 1: startPt(2) = 0
endPt(0) = 5: endPt(1) = 5: endPt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)

' Create the circle
Dim circleObj As AcadCircle
Dim centerPt(0 To 2) As Double
Dim radius As Double
centerPt(0) = 3: centerPt(1) = 3: centerPt(2) = 0
radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
ZoomAll

' Find the intersection points between the line and the circle
Dim intPoints As Variant
intPoints = lineObj.IntersectWith(circleObj, acExtendNone)

' Print all the intersection points
Dim I As Integer, j As Integer, k As Integer
Dim str As String
If VarType(intPoints) <> vbEmpty Then
For I = LBound(intPoints) To UBound(intPoints)
str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
MsgBox str, , "IntersectWith Example"
str = ""
I = I + 2
j = j + 3
k = k + 1
Next
End If
End Sub

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


#5 kysu2tung

kysu2tung

    biết pan

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

Đã gửi 21 August 2009 - 09:06 AM

Chân thành cảm ơn các bạn đã hướng dẫn
  • 0