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

[kysu2tung 0]

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

[anhcos 196]

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

[anhcos 196]

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.

[phantuhuong 218]

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

[kysu2tung 0]

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