Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
kysu2tung

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

Các bài được khuyến nghị

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
anhcos    177
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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
anhcos    177

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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phantuhuong    204
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×