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  
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ị

ks_chang    2

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
nvson    4

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  

×