Chuyển đến nội dung
Diễn đàn CADViet
thanhduan2407

Lấy tọa độ Polyline 3D

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

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

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

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

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

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

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
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ề,....

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

5sao_1.jpg

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

5sao_1.jpg

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

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


×