Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
4 replies to this topic

#1 redsea_tq

redsea_tq

    biết lệnh erase

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

Đã gửi 24 August 2010 - 08:33 PM

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!
  • 0

#2 hoa35ktxd

hoa35ktxd

    biết lệnh move

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

Đã gửi 24 August 2010 - 09:12 PM

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

  • 0

#3 redsea_tq

redsea_tq

    biết lệnh erase

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

Đã gửi 24 August 2010 - 09:45 PM

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!
  • 0

#4 hoa35ktxd

hoa35ktxd

    biết lệnh move

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

Đã gửi 24 August 2010 - 09:48 PM

Đồng hương đấy bạn ạ.
Sang bên Caulacbovb để xem thêm phần trả lời tương tự
  • 0

#5 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 24 August 2010 - 10:47 PM

Đ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

  • 0
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!