Sub CopyTextSangExcel()
Dim ChuT As AcadEntity
Dim asset As AcadSelectionSet
Dim Diembao1P As Variant, Diembao2P As Variant
Dim i As Integer
'Bo qua loi neu asset khong ton tai
On Error Resume Next
With ActiveDocument.SelectionSets
.Item("asset").Delete
'Tao doi tuong asset
Set asset = .Add("asset")
End With
'Chon toan bo doi tuong trong cua so chon vao asset
With ActiveDocument.Utility
Diembao1P = .GetPoint(, vbLf & "Chon diem bao o phia tren, ben trai:")
Diembao2P = .GetPoint(, vbLf & "Chon diem bao o phia duoi, ben phai:")
End With
asset.Select acSelectionSetWindow, Diembao1P, Diembao2P
asset.Highlight True
i = 0
'Duyet qua tung doi tuong trong asset
For Each ChuT In asset
'Chi chon doi tuong la Text
If ChuT.ObjectName = "AcDbText" Then
i = i + 1
ChuT.Highlight False
MsgBox "Gia tri cua doi tuong thu " & i & ": " & ChuT.TextString
End If
Next
MsgBox "Vung chon co " & i & " doi tuong."
asset.Highlight False
Set asset = Nothing
Set ChuT = Nothing
End Sub
(defun c:c2e ( / hangdau)
(defun sosanh (e1 e2 / p1 p2)
(setq p1 (car e1)
p2 (car e2)
)
(if (equal (cadr p1) (cadr p2) fuzz)
(< (car p1) (car p2))
(> (cadr p1) (cadr p2))
)
)
(setq
ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst)
caotext (cdr (assoc 40 (entget (ssname ss 0))))
fuzz (* caotext 1.0)
lst (vl-sort lst 'sosanh)
index 1
oldy nil
fn (getfiled "Chon file de save" "" "csv" 1)
fid (open fn "w")
)
(foreach e lst
(if (equal oldy (cadr (car e)) fuzz)
(progn
(princ "," fid)
(setq index (1+ index))
)
(progn
(if hangdau
(progn
(setq index 1)
(princ "\n" fid)
)
(setq hangdau t)
)
)
)
(princ (cdr e) fid)
(setq oldy (cadr (car e)))
)
(close fid)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss
(sslength ss)
0
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
Nhưng để lồng vào một chương trình khác thì hơi khó.Bạn dùng lệnh Dataextraction trong Cad2008 la co the lay duoc so lieu tu Cad sang Excel. Ban chon toan bo Text ban muon lay, sau mot hoi Next ban chi can chon Text và Geometry. Tiep tuc next va chi chon Value va Position X, hoặc Position Y. Lai tiếp tục Next và Next. Số liệu đó được xuất ra file Excel nằm trong My Document, ban mở file do ra và sắp xếp theo giá trị tăng hoặc giảm dần của X, Y là xong.
Bạn làm thử đi, quen rồi thấy rất tiện và chính xác.
Đúng là có thể lấy được như vậy nhưng việc xuất số liệu sang excel kết quả chỉ cho vào một cột là value, trong khi nếu trong cad một bảng có nhiều hàng và cột thì hic...hic, xuất các giá trị vào excel lại lung tung. Ví dụ, trong cad tôi có bảng làBạn dùng lệnh Dataextraction trong Cad2008 la co the lay duoc so lieu tu Cad sang Excel. Ban chon toan bo Text ban muon lay, sau mot hoi Next ban chi can chon Text và Geometry. Tiep tuc next va chi chon Value va Position X, hoặc Position Y. Lai tiếp tục Next và Next. Số liệu đó được xuất ra file Excel nằm trong My Document, ban mở file do ra và sắp xếp theo giá trị tăng hoặc giảm dần của X, Y là xong.
Bạn làm thử đi, quen rồi thấy rất tiện và chính xác.