Lệnh tìm điểm đầu, điểm cuối của đoạn thẳng trong AutoCad (1 người xem)

[N2NTrung]

các bạn cho mình hỏi để gọi ra điểm đầu, điểm cuối của 1 đoạn thẳng trong acad thì viết lệnh như thế nào với.

 

[nvson]

Bạn sử dụng thuộc tính startPoint và endPoint của đối tượng Line.
Bạn xem trong Help của VBA for AutoCad có rất nhiều ví dụ.

Sub GetPointOfLine()
 
    Dim objLine As Object
    Dim ssetObj As AcadSelectionSet
    Dim startPoint As Variant
    Dim endPoint As Variant
 
    'Ban hay thay doi phan chu do sau moi lan chay nhe!
    Set ssetObj = ThisDrawing.SelectionSets.Add("[COLOR=red]CHON_LINE_1[/COLOR]")
    ssetObj.SelectOnScreen
 
    For Each objLine In ssetObj
        If TypeName(objLine) = "IAcadLine" Then
            startPoint = objLine.startPoint
            endPoint = objLine.endPoint
            MsgBox "Diem dau cua Line: " & startPoint(0) & "," & startPoint(1)
            MsgBox "Diem cuoi cua Line: " & endPoint(0) & "," & endPoint(1)
        End If
    Next objLine
End Sub

P/S: Bạn thay đổi lại tên của đối tượng (Phấn chữ đỏ trong Code trên) sau mỗi lần chạy nhé, nếu ko thay đổi chương trình sẽ báo lỗi.

 

[lxthanh8x]

Hi,
Dùng ngông ngữ Autolisp của CAD:

(defun c:gpline()
(setq obj (entsel "\nSelect the line: ")) ; Chọn đối tượng là line
(setq data (entget (car obj))) ; Lấy dữ liệu của line vừa chọn
(setq start_point (cdr (assoc 10 data))) ; Tách điểm đầu
(setq end_point (cdr (assoc 11 data))) ; Tách điểm cuối

; Đưa kết quả ra màn hình
(princ "\nStart point: ")(princ start_point)
(princ "\nEnd point: ")(princ end_point)
(princ) ; Thoát chương trình lặng lẽ
)

Chú ý: dùng chọn cho đối tượng là LINE nhé, polyline thì không được!

 

[N2NTrung]

cám ơn bạn nvson nhiều nhiều

 

[nvson]

Nếu bạn không muốn thay đổi lại tên thì thêm đoạn code sau vào cuối chương trình:

[COLOR=red]    ThisDrawing.SelectionSets.Item("CHON_LINE_1").Delete
[/COLOR]    Set ssetObj = Nothing
    Set objLine = Nothing

 

[N2NTrung]

thank 2 bạn nhiều nhiều nhé.

 

[N2NTrung]

bạn nvson đã giúp mình viết lệnh để tìm điểm đầu điểm cuối của 1 đoạn thẳng. ý mình là muốn tạo 1 nút lệnh CommandButton để làm sao khi nhấp vào thì lệnh thực hiện dòng thông báo tạo độ các điểm: điểm đầu, điểm cuối, điểm giữa

 

[khoavu87]

Đây là một số ví dụ có thể cho bạn

àh đây minhđoans bạn đang làm dự án VBA trong cad.mình có nhiều bài VBA trong cad lắm có cần ko tớ gửi/.

 

[khoavu87]

mình cũng ko hiểu nổi bạn cần hiện tọa độ các điểm làm gì nhỉ?cad 2007 đã hôc trợ phần đó rùi mà?

 

[N2NTrung]

mình sẽ đưa sang excel để tính toán mà

 

[N2NTrung]

Mỗi lần thao tác chỉ biết chiều dài 1 đoạn thẳng (như thế thì kích mỏi tay quá), giúp tớ viết lệnh để đọc hết chiều dài các đoạn thẳng với.

 

[nvson]

bạn nvson đã giúp mình viết lệnh để tìm điểm đầu điểm cuối của 1 đoạn thẳng. ý mình là muốn tạo 1 nút lệnh CommandButton để làm sao khi nhấp vào thì lệnh thực hiện dòng thông báo tạo độ các điểm: điểm đầu, điểm cuối, điểm giữa

Mỗi lần thao tác chỉ biết chiều dài 1 đoạn thẳng (như thế thì kích mỏi tay quá), giúp tớ viết lệnh để đọc hết chiều dài các đoạn thẳng với.

Bạn thử đoạn code sau:

Option Explicit
Sub GetPointOfLine()
 
    Dim objLine As Object
    Dim ssetObj As AcadSelectionSet
    Dim startPoint As Variant
    Dim endPoint As Variant
    Dim midPoint(0 To 2) As Variant
    Dim i As Double
       
    Set ssetObj = ThisDrawing.SelectionSets.Add("CHON_LINE_1")
    ssetObj.SelectOnScreen
 
    For Each objLine In ssetObj
        If TypeName(objLine) = "IAcadLine" Then
            i = i + 1
            startPoint = objLine.startPoint
            endPoint = objLine.endPoint
                                  
            If startPoint(0) <= endPoint(0) Then
                midPoint(0) = startPoint(0) + Abs(startPoint(0) - endPoint(0)) / 2
            Else
                midPoint(0) = endPoint(0) + Abs(startPoint(0) - endPoint(0)) / 2
            End If
            If startPoint(1) <= endPoint(1) Then
                midPoint(1) = startPoint(1) + Abs(startPoint(1) - endPoint(1)) / 2
            Else
                midPoint(1) = endPoint(1) + Abs(startPoint(1) - endPoint(1)) / 2
            End If
            
            MsgBox "Diem dau cua Line " & i & vbCrLf & startPoint(0) & "," & startPoint(1)
            MsgBox "Diem cuoi cua Line " & i & vbCrLf & endPoint(0) & "," & endPoint(1)
            MsgBox "Diem giua cua Line " & i & vbCrLf & midPoint(0) & "," & midPoint(1)
        End If
    Next objLine
    
    ThisDrawing.SelectionSets.Item("CHON_LINE_1").Delete
    Set ssetObj = Nothing
    Set objLine = Nothing
    
End Sub

 

[N2NTrung]

hay quá rất rất cám ơn bạn nvson !

 

[liliheo]

chỉ cần sd dụng lệnh PE có sẵn trong cad nhé, PE enter, R enter là oke

 

[befaint]

chỉ cần sd dụng lệnh PE có sẵn trong cad nhé, PE enter, R enter là oke

1/ Đang bàn về kỹ thuật lập trình mà.
2/ Từ năm 2009 rồi thì vào tham khảo thôi, còn "đào mộ" lên làm chi?
3/ Lệnh PE nào mà cho thông số đầu mút của đoạn thẳng vậy? Nếu rành vậy thì sang cadviet...