Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
1 reply to this topic

#1 ks_chang

ks_chang

    biết vẽ line

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

Đã gửi 04 August 2010 - 02:22 PM

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.
Hình đã gửi
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 đỡ !
  • 0

#2 nvson

nvson

    biết vẽ ellipse

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

Đã gửi 31 October 2011 - 01:23 PM

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.
Hình đã gửi
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

  • 1