Đến nội dung


Hình ảnh
- - - - -

Get Object properties


  • Please log in to reply
21 replies to this topic

#1 nkgedadknr

nkgedadknr

    biết vẽ line

  • Validating
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 07 February 2009 - 03:57 PM

Các bác cao htủ cho em hỏi viết code VBA làm thế nào để lấy thuộc tính trong Acad xuất qua Excel.

VD: thuộc tính của PLine là length + Area và closed: yes or no

Em muốn lấy các properties này sang Excel

Thanks các bác
  • 0

#2 phantuhuong

phantuhuong

    biết dimstyle

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

Đã gửi 08 February 2009 - 12:18 PM

Các bác cao htủ cho em hỏi viết code VBA làm thế nào để lấy thuộc tính trong Acad xuất qua Excel.

VD: thuộc tính của PLine là length + Area và closed: yes or no

Em muốn lấy các properties này sang Excel

Thanks các bác


Việc liên kết Excel và AutoCad đã có nhiều rồi. Thủ tục dưới đây sẽ lấy thông tin thuộc tính đối tượng Polyline:

Sub Example_Area()
' This example creates a polyline object and
' then uses the area property to find the
' area of that polyline.

Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
Dim plineArea As Double

' Establish the points for the Polyline
points(0) = 3: points(1) = 7
points(2) = 9: points(3) = 2
points(4) = 3: points(5) = 5

' Create the polyline in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

' Đóng polyline và cập nhật
plineObj.Closed = True
plineObj.Update
ZoomAll

' Lấy diện tích của polyline
plineArea = plineObj.Area

MsgBox "The area of the new Polyline is: " & plineArea, vbInformation, "Area Example"
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!


#3 nkgedadknr

nkgedadknr

    biết vẽ line

  • Validating
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 09 February 2009 - 03:32 PM

Việc liên kết Excel và AutoCad đã có nhiều rồi. Thủ tục dưới đây sẽ lấy thông tin thuộc tính đối tượng Polyline:

Sub Example_Area()
' This example creates a polyline object and
' then uses the area property to find the
' area of that polyline.

Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
Dim plineArea As Double

' Establish the points for the Polyline
points(0) = 3: points(1) = 7
points(2) = 9: points(3) = 2
points(4) = 3: points(5) = 5

' Create the polyline in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

' Đóng polyline và cập nhật
plineObj.Closed = True
plineObj.Update
ZoomAll

' Lấy diện tích của polyline
plineArea = plineObj.Area

MsgBox "The area of the new Polyline is: " & plineArea, vbInformation, "Area Example"
End Sub


Dạ nhờ bác thêm chút xíu, em có các text trong acad, làm thế nào duyệt qua tất cả các text này lấy nội dung của nó và gửi qua Excel ạ?
  • 0

#4 nkgedadknr

nkgedadknr

    biết vẽ line

  • Validating
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 09 February 2009 - 03:33 PM

Việc liên kết Excel và AutoCad đã có nhiều rồi. Thủ tục dưới đây sẽ lấy thông tin thuộc tính đối tượng Polyline:

Sub Example_Area()
' This example creates a polyline object and
' then uses the area property to find the
' area of that polyline.

Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
Dim plineArea As Double

' Establish the points for the Polyline
points(0) = 3: points(1) = 7
points(2) = 9: points(3) = 2
points(4) = 3: points(5) = 5

' Create the polyline in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

' Đóng polyline và cập nhật
plineObj.Closed = True
plineObj.Update
ZoomAll

' Lấy diện tích của polyline
plineArea = plineObj.Area

MsgBox "The area of the new Polyline is: " & plineArea, vbInformation, "Area Example"
End Sub


Dạ nhờ bác thêm chút xíu, em có các text trong acad, làm thế nào duyệt qua tất cả các text này lấy nội dung của nó và gửi qua Excel ạ?
  • 0

#5 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 10 February 2009 - 02:39 PM

VD về sub lấy nội dung text trong ModelSpace
Sub GetText()
Dim i&, n&, s$
Dim Obj
n = ModelSpace.Count
For i = 0 To n - 1
Set Obj = ModelSpace.Item(i)
If TypeName(Obj) = "IAcadText" Then
s = Obj.TextString
End If
Next i

End Sub

  • 0

#6 discovery

discovery

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 17 February 2009 - 04:45 PM

Việc liên kết Excel và AutoCad đã có nhiều rồi. Thủ tục dưới đây sẽ lấy thông tin thuộc tính đối tượng Polyline:

Sub Example_Area()
' This example creates a polyline object and
' then uses the area property to find the
' area of that polyline.

Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
Dim plineArea As Double

' Establish the points for the Polyline
points(0) = 3: points(1) = 7
points(2) = 9: points(3) = 2
points(4) = 3: points(5) = 5

' Create the polyline in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

' Đóng polyline và cập nhật
plineObj.Closed = True
plineObj.Update
ZoomAll

' Lấy diện tích của polyline
plineArea = plineObj.Area

MsgBox "The area of the new Polyline is: " & plineArea, vbInformation, "Area Example"
End Sub

Chào bác !
Đây là chương trình lấy thuộc tính của đối tượng đã có sẵn (thiết lập từ chương trình).
Còn bây giờ em có thể lấy thuộc tính từ một hay nhiều đối tượng được vẽ trên modelspace không ạ ?
Cảm ơn bác nhiều (:cheers:) !
  • 0

#7 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 25 February 2009 - 12:56 AM

Bạn tham khảo 2 ví dụ này xem nhé
Private Sub TongDienTichPolyline()
Dim objACAD As AcadApplication
Dim objDOC As AcadDocument
Dim objNEWSS As AcadSelectionSet

Dim Tong As Double
Set objACAD = ThisDrawing.Application
Set objDOC = objACAD.ActiveDocument
On Error Resume Next
objDOC.SelectionSets.Item("VBA").Delete
Err.Clear
Set objNEWSS = objDOC.SelectionSets.Add("VBA")
objNEWSS.Select acSelectionSetAll
For I = 0 To objNEWSS.Count - 1
If objNEWSS.Item(I).ObjectName = "AcDbPolyline" Then
Tong = Tong + objNEWSS.Item(I).Area
End If
Next
If Not objNEWSS Is Nothing Then objNEWSS.Delete
MsgBox Tong
End Sub
Private Sub DienTichPolyline()
Dim Pl As AcadObject
Dim Ba As Variant
ThisDrawing.Utility.GetEntity Pl, Ba, "Choòn ðôìi týõòng"
If Pl.ObjectName = "AcDbPolyline" Then MsgBox Pl.Area
End Sub
  • 0

#8 discovery

discovery

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 26 February 2009 - 10:15 PM

Bạn tham khảo 2 ví dụ này xem nhé
Private Sub TongDienTichPolyline()
Dim objACAD As AcadApplication
Dim objDOC As AcadDocument
Dim objNEWSS As AcadSelectionSet

Dim Tong As Double
Set objACAD = ThisDrawing.Application
Set objDOC = objACAD.ActiveDocument
On Error Resume Next
objDOC.SelectionSets.Item("VBA").Delete
Err.Clear
Set objNEWSS = objDOC.SelectionSets.Add("VBA")
objNEWSS.Select acSelectionSetAll
For I = 0 To objNEWSS.Count - 1
If objNEWSS.Item(I).ObjectName = "AcDbPolyline" Then
Tong = Tong + objNEWSS.Item(I).Area
End If
Next
If Not objNEWSS Is Nothing Then objNEWSS.Delete
MsgBox Tong
End Sub
Private Sub DienTichPolyline()
Dim Pl As AcadObject
Dim Ba As Variant
ThisDrawing.Utility.GetEntity Pl, Ba, "Choòn ðôìi týõòng"
If Pl.ObjectName = "AcDbPolyline" Then MsgBox Pl.Area
End Sub


Thanks u pác rất nhiều !
Tuy em không hiểu hết chương trình nhưng có phải từ vòng lặp For sẽ cho phép ta scan hết các Object trong ModelSpace phải không ah ?
Pác có thể giải thích cho em một số dòng lệnh này được không ạ ?

1. Trong đoạn code này có phải là để nhẩy đến đấy khi có Er phải khôg ạ ?
Như vậy thì đoạn Code sẽ kéo dài đến End Sub phải không ạ ?

On Error Resume Next
objDOC.SelectionSets.Item("VBA").Delete
Err.Clear
Set objNEWSS = objDOC.SelectionSets.Add("VBA")
objNEWSS.Select acSelectionSetAll


2. Thuộc tính 'objNEWSS.Item(I).ObjectName' thì pác xây dựng mẳng Item(I) ở đâu vậy sao em khôgn thấy ?

For I = 0 To objNEWSS.Count - 1
If objNEWSS.Item(I).ObjectName = "AcDbPolyline" Then
Tong = Tong + objNEWSS.Item(I).Area
End If
Next

3. Câu lệnh 'If Not objNEWSS Is Nothing Then objNEWSS.Delete' để làm gì vậy pác ?
  • 0

#9 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 27 February 2009 - 09:55 AM

Private Sub TongDienTichPolyline()'Tính tổng diện tích của tất cả các polyline có trong bản vẽ
Dim objACAD As AcadApplication
Dim objDOC As AcadDocument
Dim objNEWSS As AcadSelectionSet

Dim Tong As Double
Set objACAD = ThisDrawing.Application
Set objDOC = objACAD.ActiveDocument
On Error Resume Next 'Nếu xuất hiện lỗi thì tiếp tục thực hiện.
objDOC.SelectionSets.Item("VBA").Delete'Xóa đối tượng có tên là "VBA", đây là chỗ xảy ra lỗi khi trong bản vẽ không tồn tại đối tượng "VBA"
Err.Clear'Xóa thông báo lỗi, chương trình tiếp tục thực hiện.
Set objNEWSS = objDOC.SelectionSets.Add("VBA")' Tạo đối tượng với tên là "VBA", nếu không có dòng lệnh xóa "VBA" ở trên thì chỗ này sẽ xảy ra lỗi do đối tượng "ABV" đã được tạo ra trong lần thực hiện trước dẫn đến trùng tên.
objNEWSS.Select acSelectionSetAll'Chọn tất cả các đối tượng tỏng bản vẽ
For I = 0 To objNEWSS.Count - 1'Duyệt các đối tượng đã được chọn
If objNEWSS.Item(I).ObjectName = "AcDbPolyline" Then'Lọc các đối tượng là Polyline
Tong = Tong + objNEWSS.Item(I).Area'Cộng tổng
End If
Next
If Not objNEWSS Is Nothing Then objNEWSS.Delete'Xóa danh mục chọn ("ABC"). Câu lệnh này có ý nghĩa như sau: Nếu đối tượng objNEWSS tồn tại thì xóa nó đi (Not Is Nothing, phủ định của phủ định = khẳng định. If objNEWSS Is Nothing Then có nghĩa là nếu đối tượng không tồn tại).
MsgBox Tong
End Sub

Private Sub DienTichPolyline()'Lấy diện tích của 1 polyline
Dim Pl As AcadObject
Dim Ba As Variant
ThisDrawing.Utility.GetEntity Pl, Ba, "Choòn ðôìi týõòng"
If Pl.ObjectName = "AcDbPolyline" Then MsgBox Pl.Area
End Sub
  • 3

#10 xuanthu189

xuanthu189

    biết zoom

  • Members
  • Pip
  • 17 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 04 March 2009 - 11:17 AM

Nếu bây giờ em muốn lấy thuộc tính của nhiều đối tượng khi ta select nhiều đối tượng thì ta dùng câu lệnh thế nào hả bác.Em đã modify bài trên để thử nhưng không được.Mong bác chỉ giáo!
  • 0

#11 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 24 March 2009 - 10:23 AM

Nếu bây giờ em muốn lấy thuộc tính của nhiều đối tượng khi ta select nhiều đối tượng thì ta dùng câu lệnh thế nào hả bác.Em đã modify bài trên để thử nhưng không được.Mong bác chỉ giáo!

Bạn post chương trình và ghi rõ các yêu cầu xem
  • 0

#12 nkgedadknr

nkgedadknr

    biết vẽ line

  • Validating
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 June 2009 - 03:02 PM

Bây giờ Em muốn lọc tất cả diện tích của các polyline nhưng cùng nằm trên 1 layer, có cùng màu, hoặc cùng width thì làm sao các bác ơi
  • 0

#13 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 12 June 2009 - 10:11 PM

Bây giờ Em muốn lọc tất cả diện tích của các polyline nhưng cùng nằm trên 1 layer, có cùng màu, hoặc cùng width thì làm sao các bác ơi


Lọc diện tích là lấy tổng à. Ý của bạn chưa rõ ràng lắm.
  • 0
Clear sky!

MF Rock collection.

#14 nkgedadknr

nkgedadknr

    biết vẽ line

  • Validating
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 June 2009 - 07:10 AM

ý tôi là viết tất tả các diện tích của mỗi polyline ra thành text, sau đó lọc từng text để lấy diện tích từng polyline có đánh số hiệu để quản lý từng polyline
  • 0

#15 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 13 June 2009 - 08:06 AM

ý tôi là viết tất tả các diện tích của mỗi polyline ra thành text, sau đó lọc từng text để lấy diện tích từng polyline có đánh số hiệu để quản lý từng polyline

Chào bạn nkgedadknr
Tue_NV xin góp ý với bạn : khi viết bài bạn nên nhìn nhận vấn đề một cách tổng quát và diễn đạt sao cho mọi người dể hiểu nhất.

Tue_NV hỏi bạn một câu nhé : Bạn viết diện tích của mỗi polyline thì Polyline hở làm gì có diện tích hở bạn???

sau đó lọc từng text để lấy diện tích từng polyline có đánh số hiệu để quản lý từng polyline : Câu này thì mình chưa hiểu ý của bạn lắm

Nếu bạn cần sự giúp đỡ xin hãy nói rõ ràng, mạch lạc và có thể kèm file minh hoạ nếu có thể

Chào bạn. Chúc bạn vui
  • 0

#16 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 13 June 2009 - 09:25 AM

Tue_NV hỏi bạn một câu nhé : Bạn viết diện tích của mỗi polyline thì Polyline hở làm gì có diện tích hở bạn???

Polyline hở vẩn có diện tích bạn Tue à. Cad tính diện tích là miền kín tạo bởi Polyline và giới hạn bằng điểm đầu và điểm cuối của Polyline.
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#17 nkgedadknr

nkgedadknr

    biết vẽ line

  • Validating
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 June 2009 - 09:31 AM

chào bạn Tue NV

cám ơn bạn đã góp ý

1. polyline hở thì cũng có diện tích bạn ơi. Bạn xem lại Help trong Acad nhé !!!

2. mình muốn viết code show tất cả diện tích, chiều dài polyline thành từng text đặt cạnh polyline đó trên màn hình. Các polyline và text tương ứng có thể nằm trên từng lớp khác nhau. Sau đó mình viết code lọc từng text lấy diện tích, chiều dài của từng polyline theo tứng layer.

3. Không biết mình viết như vậy đã rõ ràng chưa bạn ơi, còn cái gì tổng quát hay cách diễn đạt thì mình cũng đang hoàn thiện cả đời đó bạn ạ, bạn có tips nào thì chỉ mình thêm nhe

Thân ái
  • 0

#18 nkgedadknr

nkgedadknr

    biết vẽ line

  • Validating
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 June 2009 - 09:32 AM

chào bạn Tue NV

cám ơn bạn đã góp ý

1. polyline hở thì cũng có diện tích bạn ơi. Bạn xem lại Help trong Acad nhé !!!

2. mình muốn viết code show tất cả diện tích, chiều dài polyline thành từng text đặt cạnh polyline đó trên màn hình. Các polyline và text tương ứng có thể nằm trên từng lớp khác nhau. Sau đó mình viết code lọc từng text lấy diện tích, chiều dài của từng polyline theo tứng layer.

3. Không biết mình viết như vậy đã rõ ràng chưa bạn ơi, còn cái gì tổng quát hay cách diễn đạt thì mình cũng đang hoàn thiện cả đời đó bạn ạ, bạn có tips nào thì chỉ mình thêm nhe

Thân ái
  • 0

#19 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 13 June 2009 - 09:47 AM

Trường hợp anh Duy và bạn 'nkgedadknr' nói đến là trường hợp 1 Polyline 2 phân đoạn trở lên thì mới có diện tích như anh duy nói.
Chứ còn 2 Pline trở lên tạo thành miền hở thì không có diện tích. Hoàn toàn không thể tính diện tích được
Tue_NV vẫn biết là bạn nkgedadknr diễn đạt như anh Duy nói nhưng mình muốn bạn nkgedadknr nói rõ ý mà thôi :lol2:
  • 0

#20 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 13 June 2009 - 10:01 AM

2. mình muốn viết code show tất cả diện tích, chiều dài polyline thành từng text đặt cạnh polyline đó trên màn hình. Các polyline và text tương ứng có thể nằm trên từng lớp khác nhau. Sau đó mình viết code lọc từng text lấy diện tích, chiều dài của từng polyline theo tứng layer.

Nói chung yêu cầu của bạn còn chung chung chưa rỏ mình đưa ra các ý để bạn lựa chọ nhé:
Yêu cầu:
-Hoặc Chọn pline đầu vào:
+Theo layer.
+Theo Width.
-Hoặc xuất kết quả:
+Theo (cùng) layer của pline.
Mình khuyên bạn đưa ra đề bài theo hướng 1 cì theo hướng 2 để xuất kết quả theo Widht là rất khó (khó trong việc quả lý ấy)

À mình nghỉ ra cách là xuất kết quả ra block thuộc tính trong đó thể hiện cỉ thông tin layer và width của pline lúc này phải viết thêm cả lisp chọn kết quả để lọc ra các kết quả bạn mong muốn => mình không rành thèn lisp đọc block thuộc tính nên sẽ ..................... ngồi chờ người khác viết để học hỏi.

@Tue. diện tích bằng 0 chứ không phải không thể tính được.
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D