Đến nội dung


Hình ảnh
* * - - - 3 Bình chọn

Lấy tọa độ Polyline 3D


  • Please log in to reply
8 replies to this topic

#1 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 10 November 2010 - 08:26 AM

Các bác có thể chỉ em cách thức chọn 1 Polyline 3D và lấy ra được tất cả các đỉnh của Polyline 3D được không ạ. Cảm ơn các bác rất nhiều
. Hic
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 10 November 2010 - 04:23 PM

Các bác có thể chỉ em cách thức chọn 1 Polyline 3D và lấy ra được tất cả các đỉnh của Polyline 3D được không ạ. Cảm ơn các bác rất nhiều
. Hic

Không ai trả lời mình sao ?? Hic. Nhờ các anh em trợ giúp
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#3 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 10 November 2010 - 04:44 PM

Không ai trả lời mình sao ??

Bạn đã dùng cái này chưa?
(setq dsdinh (acet-geom-vertex-list (car (entsel))))
  • 0

#4 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 10 November 2010 - 04:47 PM

Bạn đã dùng cái này chưa?
(setq dsdinh (acet-geom-vertex-list (car (entsel))))

Cảm ơn bạn. Mình viết trên VBA. Cảm ơn bạn đã quan tâm. Hic
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#5 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 10 November 2010 - 04:57 PM

Không ai trả lời mình sao ?? Hic. Nhờ các anh em trợ giúp

Chào bạn thanhduan2407,
Bạn thử dùng cái này xem nó có đúng ý bạn không nhé:
(acet-geom-vertex-list doituongt)
Trong đó biến doituongt là ename của đối tượng 3D polyline của bạn.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 Tri

Tri

    biết vẽ circle

  • Members
  • PipPip
  • 31 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 10 November 2010 - 06:42 PM

Chào bạn thanhduan2407,
Bạn thử dùng cái này xem nó có đúng ý bạn không nhé:
(acet-geom-vertex-list doituongt)
Trong đó biến doituongt là ename của đối tượng 3D polyline của bạn.

Cũng trật luôn vì đây là chuyên mục VBA mà bác :iluvyousmiley:
  • 0

#7 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 10 November 2010 - 06:49 PM

Cũng trật luôn vì đây là chuyên mục VBA mà bác :iluvyousmiley:

Hề hề hề.
Sorry các bác, mắt mũi kèm nhèm nên đọc lộn hỉ???? Vụ này thì mình hơi bị nghễnh ngãng rùi. Xin dựa cột ngồi nghe vậy. Hề hề hề,....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#8 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 11 November 2010 - 11:22 AM

Các bác có thể chỉ em cách thức chọn 1 Polyline 3D và lấy ra được tất cả các đỉnh của Polyline 3D được không ạ. Cảm ơn các bác rất nhiều
. Hic

Chèn TEXT tại các đỉnh của PLINE (Polyline, LWPolyline, 3DPolyline)
giá trị của TEXT là tọa độ đỉnh đó.
(sưu tầm)
Option Explicit

Sub VertText()
Dim vertTextObj As AcadText
Dim objEnt As AcadEntity
Dim spaceObj As AcadBlock
Dim TxtInsPoint(2) As Double
Dim dblHeight As Double
Dim strText As String
Dim n As Integer
Dim i As Integer

If ThisDrawing.ActiveSpace = acModelSpace Then
Set spaceObj = ThisDrawing.ModelSpace
Else
Set spaceObj = ThisDrawing.PaperSpace
End If

Dim objSetPoly As AcadSelectionSet
Set objSetPoly = ThisDrawing.SelectionSets.Add("MyPoly")
objSetPoly.SelectOnScreen

For Each objEnt In objSetPoly
Dim vert As Variant
If TypeOf objEnt Is AcadLWPolyline Then
n = 2
ElseIf TypeOf objEnt Is Acad3DPolyline Or TypeOf objEnt Is AcadPolyline Then
n = 3
Else
MsgBox "Wrong object"
End If

If n > 0 Then
vert = objEnt.Coordinates
dblHeight = 150
For i = LBound(vert) To UBound(vert) Step n

If TypeOf objEnt Is AcadLWPolyline Then
strText = R2S(CStr(vert(i)), 2, 5) & "," & R2S(CStr(vert(i + 1)), 2, 5)
ElseIf TypeOf objEnt Is Acad3DPolyline Or TypeOf objEnt Is AcadPolyline Then
strText = R2S(CStr(vert(i)), 2, 5) & "," & R2S(CStr(vert(i + 1)), 2, 5) & _
"," & R2S(CStr(vert(i + 2)), 2, 5)
End If

TxtInsPoint(0) = vert(i)
TxtInsPoint(1) = vert(i + 1)
If TypeOf objEnt Is AcadLWPolyline Then
TxtInsPoint(2) = 0#
ElseIf TypeOf objEnt Is Acad3DPolyline Or TypeOf objEnt Is AcadPolyline Then
TxtInsPoint(2) = vert(i + 2)
End If

Set vertTextObj = spaceObj.AddText(strText, TxtInsPoint, dblHeight)
Next
End If
Next

objSetPoly.Delete
Set objSetPoly = Nothing
End Sub

'' convert real to string
Function R2S(dblVal As Double, unitEnum As Long, intPrec As Integer) As String
' unitEnum:
' 2-decimal
' 4-architectural etc.
' intPrec - precision
R2S = ThisDrawing.Utility.RealToString(dblVal, unitEnum, intPrec)
End Function

To Admin :
Forum có vấn đề : Topic này đuợc đánh dấu 5 sao ?
Hình đã gửi
  • 0

#9 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 11 November 2010 - 07:38 PM

Chèn TEXT tại các đỉnh của PLINE (Polyline, LWPolyline, 3DPolyline)
giá trị của TEXT là tọa độ đỉnh đó.
(sưu tầm)

Option Explicit

Sub VertText()
Dim vertTextObj As AcadText
Dim objEnt As AcadEntity
Dim spaceObj As AcadBlock
Dim TxtInsPoint(2) As Double
Dim dblHeight As Double
Dim strText As String
Dim n As Integer
Dim i As Integer

If ThisDrawing.ActiveSpace = acModelSpace Then
Set spaceObj = ThisDrawing.ModelSpace
Else
Set spaceObj = ThisDrawing.PaperSpace
End If

Dim objSetPoly As AcadSelectionSet
Set objSetPoly = ThisDrawing.SelectionSets.Add("MyPoly")
objSetPoly.SelectOnScreen

For Each objEnt In objSetPoly
Dim vert As Variant
If TypeOf objEnt Is AcadLWPolyline Then
n = 2
ElseIf TypeOf objEnt Is Acad3DPolyline Or TypeOf objEnt Is AcadPolyline Then
n = 3
Else
MsgBox "Wrong object"
End If

If n > 0 Then
vert = objEnt.Coordinates
dblHeight = 150
For i = LBound(vert) To UBound(vert) Step n

If TypeOf objEnt Is AcadLWPolyline Then
strText = R2S(CStr(vert(i)), 2, 5) & "," & R2S(CStr(vert(i + 1)), 2, 5)
ElseIf TypeOf objEnt Is Acad3DPolyline Or TypeOf objEnt Is AcadPolyline Then
strText = R2S(CStr(vert(i)), 2, 5) & "," & R2S(CStr(vert(i + 1)), 2, 5) & _
"," & R2S(CStr(vert(i + 2)), 2, 5)
End If

TxtInsPoint(0) = vert(i)
TxtInsPoint(1) = vert(i + 1)
If TypeOf objEnt Is AcadLWPolyline Then
TxtInsPoint(2) = 0#
ElseIf TypeOf objEnt Is Acad3DPolyline Or TypeOf objEnt Is AcadPolyline Then
TxtInsPoint(2) = vert(i + 2)
End If

Set vertTextObj = spaceObj.AddText(strText, TxtInsPoint, dblHeight)
Next
End If
Next

objSetPoly.Delete
Set objSetPoly = Nothing
End Sub

'' convert real to string
Function R2S(dblVal As Double, unitEnum As Long, intPrec As Integer) As String
' unitEnum:
' 2-decimal
' 4-architectural etc.
' intPrec - precision
R2S = ThisDrawing.Utility.RealToString(dblVal, unitEnum, intPrec)
End Function

To Admin :
Forum có vấn đề : Topic này đuợc đánh dấu 5 sao ?
Hình đã gửi

Hi. Cảm ơn bác Gia_Bach. Em sẽ nghiên cứu .
Tại em buồn quá nên nghịch kích vào ngôi sao ý mà. Không có ý gì hết. Hi. Bác để ý hết chỗ nói. Hi. Cảm ơn bác
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn