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

[redsea_tq 16]

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!

[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

[redsea_tq 16]

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!

[hoa35ktxd 38]

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

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

[phantuhuong 218]

Đ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