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  
redsea_tq

Giúp em tìm chiều dài đoạn thẳng trong cad!

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

redsea_tq    13

Em chào các bác!

em có một chương trình nhỏ dùng để đo và ghi cao độ tự động của một điểm. khi thực hiện ta select 1 đoạn thẳng rồi chương trình tính chiều dài đoạn thẳng đó và tự động ghi chiều dài đoạn thẳng đó. em dùng selectionset nhung chỉ thay đổi được màu của đối tượng còn các thuộc tính khác thì em không biết phải làm thế nào, mong các bác giúp đỡ vì em mới học vba.

Em cám ơn các bác rất nhiều!

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

Cái này có được không?

Sub blockcount()
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
Dim Acobj As AcadObject
Dim Ac_Line As AcadLine
ssetObj.SelectOnScreen
For Each Acobj In ssetObj
	If Acobj.ObjectName = "AcDbLine" Then
		Set Ac_Line = Acobj
		MsgBox Ac_Line.Length
		Exit For
	End If
Next
ThisDrawing.SelectionSets.Item("SSET").Delete
End Sub

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
redsea_tq    13
Cái này có được không?

Sub blockcount()
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
Dim Acobj As AcadObject
Dim Ac_Line As AcadLine
ssetObj.SelectOnScreen
For Each Acobj In ssetObj
	If Acobj.ObjectName = "AcDbLine" Then
		Set Ac_Line = Acobj
		MsgBox Ac_Line.Length
		Exit For
	End If
Next
ThisDrawing.SelectionSets.Item("SSET").Delete
End Sub

 

Em cám ơn bác rất nhiều, đúng cái em cần đây ah. em ở Tuyên Quang, em và bác là hàng xóm đấy. rất hân hạnh được làm quen và học hỏi 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
hoa35ktxd    38

Đồng hương đấy bạn ạ.

Sang bên Caulacbovb để xem thêm phần trả lời tương tự

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

Đoạn code trên có thể rút gọn bớt và bổ sung như sau:

 

Sub blockcount()
Dim ssetObj As AcadSelectionSet

on error resume next
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
Dim Acobj As AcadLine
ssetObj.SelectOnScreen
For Each Acobj In ssetObj
	If Acobj.ObjectName = "AcDbLine" Then
		 MsgBox Acobj.Length
		Exit For
	End If
Next
ThisDrawing.SelectionSets.Item("SSET").Delete
Set Acobj =nothing
End Sub

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  

×