Chuyển đến nội dung
Diễn đàn CADViet
nkgedadknr

Get Object properties

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

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

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

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
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 ạ?

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
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 ạ?

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

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

  • Vote tăng 1

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
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:) !

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

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

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
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 ?

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

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

  • Vote tăng 3

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

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!

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

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

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

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
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.

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ô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

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ô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

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
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.

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

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

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

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

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

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:

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
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.

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

vậy các bác sửa giúp mình đoạn code này với, mình ko biết nó sai chỗ nào

 

Sub Test()

Dim InsertionPoint()

Dim objEnt As AcadEntity

Dim varPick As Variant

Dim textId, text

Dim myArea

 

'%<\AcObjProp.16.2 Object(%<\_ObjId 2126377576>%).Length \f "%th44">%

'%<AcObjProp Object(%<_ObjId 2126689144>%).Area>%

 

ThisDrawing.Utility.GetEntity objEnt, varPick, vbCr & "Select a polyline"

textId = objEnt.ObjectID

 

Debug.Print textId

 

text = "%<\AcObjProp Object(" & textId & ").Area>%"

 

InsertionPoint(0) = 0: InsertionPoint(1) = 0: InsertionPoint(2) = 0

Height = 0.08

 

Set myArea = ThisDrawing.ModelSpace.AddText(text, InsertionPoint, Height)

 

Debug.Print myArea.TextString

 

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
InsertionPoint(0) = 0: InsertionPoint(1) = 0: InsertionPoint(2) = 0

 

Bạn chưa khai báo kích thước mảng, sẽ có lỗi lúc chạy (runtime error)

 

Nên sửa Dim InsertionPoint(2) as Double

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

×