Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
ks_chang

Vẽ Pline qua điểm đầu (hoặc cuối) của Line bằng VBA

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

Mình có 1 loạt các Line (màu trắng trong hình), giờ mình muốn nối các đỉnh hoặc đáy của các Line này lại thành Pline đường màu vàng.

ScreenShot001-1.jpg

Mình sử dụng phép Select và lấy ra điểm đầu hoặc điểm cuối của Line (Mình mạc định Select theo Fence để thứ tự các điểm là từ trái qua phải hoặc ngược lại):

Dim gpCode(0 To 3) As Integer

Dim dataValue(0 To 2) As Variant

gpCode(0) = -4: dataValue(0) = "<or"

gpCode(1) = 0: dataValue(1) = "Line"

gpCode(2) = -4: dataValue(2) = "or>"

ssetObj.SelectOnScreen gpCode, dataValue

n = ssetObj.Count

Dim ent As AcadEntity

For Each ent In ssetObj

Dim get3Dpts As Variant

get3Dpts = ent.EndPoint

Next ent

 

Giờ muốn nối các đỉnh này lại bằng phương thức:

 

Dim plineObj As AcadLWPolyline

Set plineObj = ThisDrawing.ModelSpace.AddPolyline(get3Dpts)

thì điểm get3Dpts phải là mảng có phần tử tăng từ 0 tới n-1 ( get3Dpts(0), get3Dpts(1),....get3Dpts(n-1) )

 

Xin hỏi có cách nào để gán mảng get3Dpts tăng dần như vậy ko nhỉ? (sau quá trình For Each ...Next)

Cám ơn và mong được giúp đỡ !

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

Mình có 1 loạt các Line (màu trắng trong hình), giờ mình muốn nối các đỉnh hoặc đáy của các Line này lại thành Pline đường màu vàng.

ScreenShot001-1.jpg

Mình sử dụng phép Select và lấy ra điểm đầu hoặc điểm cuối của Line (Mình mạc định Select theo Fence để thứ tự các điểm là từ trái qua phải hoặc ngược lại):

 

Dim gpCode(0 To 3) As Integer

Dim dataValue(0 To 2) As Variant

gpCode(0) = -4: dataValue(0) = "<or"

gpCode(1) = 0: dataValue(1) = "Line"

gpCode(2) = -4: dataValue(2) = "or>"

ssetObj.SelectOnScreen gpCode, dataValue

n = ssetObj.Count

 

Dim ent As AcadEntity

For Each ent In ssetObj

Dim get3Dpts As Variant

get3Dpts = ent.EndPoint

Next ent

 

 

Giờ muốn nối các đỉnh này lại bằng phương thức:

 

Dim plineObj As AcadLWPolyline

Set plineObj = ThisDrawing.ModelSpace.AddPolyline(get3Dpts)

 

thì điểm get3Dpts phải là mảng có phần tử tăng từ 0 tới n-1 ( get3Dpts(0), get3Dpts(1),....get3Dpts(n-1) )

 

Xin hỏi có cách nào để gán mảng get3Dpts tăng dần như vậy ko nhỉ? (sau quá trình For Each ...Next)

Cám ơn và mong được giúp đỡ !

 

Bạn dùng cách khai báo mảng Redim Preserve...

 

Public Sub DrawPLine()
Dim n, i
Dim gpCode(0 To 2) As Integer
Dim dataValue(0 To 2) As Variant
Dim get3Dpts As Variant
Dim ent As AcadEntity
Dim plineObj As AcadPolyline
Dim ssetObj As AcadSelectionSet
Dim ptPline() As Double
Set ssetObj = ThisDrawing.SelectionSets.Add("AAA")
gpCode(0) = -4: dataValue(0) = "<or"
gpCode(1) = 0: dataValue(1) = "Line"
gpCode(2) = -4: dataValue(2) = "or>"
ssetObj.SelectOnScreen gpCode, dataValue
n = ssetObj.Count
For Each ent In ssetObj
i = i + 3
get3Dpts = ent.EndPoint
ReDim Preserve ptPline(0 To i - 1) As Double
ptPline(i - 3) = get3Dpts(0)
ptPline(i - 2) = get3Dpts(1)
ptPline(i - 1) = get3Dpts(2)
Next ent
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(ptPline())
ssetObj.Delete
End Sub

  • 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

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  

×