Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
tnmtpc

ghi dữ liệu từ Cad sang file Excel đã có

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

Trên màn hình Cad có các text: textA, textB, textC,...textN; Sử dụng lisp để ghi các text trên vào file Excel đã có trên đĩa, ví dụ file *.xls đã có dữ liệu đến row 15, ghi tiếp các text trên vào row 16 như sau: textA ghi vào cell A16, textB vào cell B16, textC vào cell C16,... textN vào cell N16.

Nhờ các Bác viết hộ lisp để thực hiện được yêu cầu trên, cám ơn trướ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
Trên màn hình Cad có các text: textA, textB, textC,...textN; Sử dụng lisp để ghi các text trên vào file Excel đã có trên đĩa, ví dụ file *.xls đã có dữ liệu đến row 15, ghi tiếp các text trên vào row 16 như sau: textA ghi vào cell A16, textB vào cell B16, textC vào cell C16,... textN vào cell N16.

Nhờ các Bác viết hộ lisp để thực hiện được yêu cầu trên, cám ơn trước

Nếu bạn dùng VBA thì dùng cái này xem sao.CommonDialog của mình bị lỗi nên fải dùng inputbox hơi bất tiện,bạn có thể chỉnh lại cái này trong code.

 

Sub GetText()
Dim sset As AcadSelectionSet
Dim checkSS As Boolean
Dim row, i As Double
Dim Text As AcadText
Dim MText As AcadMText

checkSS = False
For i = 1 To ThisDrawing.SelectionSets.count
   If ThisDrawing.SelectionSets.Item(i - 1).Name = "SSET" Then
       Set sset = ThisDrawing.SelectionSets.Item(i - 1)
       sset.Clear
       checkSS = True
       Exit For
   Else
       checkSS = False
   End If
Next

If checkSS = False Then Set sset = ThisDrawing.SelectionSets.Add("SSET")

sset.SelectOnScreen
If sset.count = 0 Then Exit Sub

'-------------------------------------
Dim ExcelApp As Object
Dim CheckData As Boolean
Dim PathFile As String
CheckData = False
Set ExcelApp = CreateObject("Excel.application")
PathFile = InputBox("Nhap vao duong dan day du cua file", "Full path")
ExcelApp.workbooks.Open PathFile
row = 1
While CheckData = False
   If ExcelApp.cells(row, 1).Formula <> "" Then
       CheckData = False
       row = row + 1
   Else
       CheckData = True
   End If
Wend
For i = 0 To sset.count - 1
   Select Case sset.Item(i).ObjectName
       Case "AcDbText"
           Set Text = sset.Item(i)
           ExcelApp.cells(row, 1 + i).Formula = Text.TextString
       Case "AcDbMText"
           Set MText = sset.Item(i)
           ExcelApp.cells(row, 1 + i).Formula = MText.TextString
   End Select
Next

ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWorkbook.Close
ExcelApp.Application.Quit
Set ExcelApp = Nothing

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
Nếu bạn dùng VBA thì dùng cái này xem sao.CommonDialog của mình bị lỗi nên fải dùng inputbox hơi bất tiện,bạn có thể chỉnh lại cái này trong code.

 

Sub GetText()
Dim sset As AcadSelectionSet
Dim checkSS As Boolean
Dim row, i As Double
Dim Text As AcadText
Dim MText As AcadMText

checkSS = False
For i = 1 To ThisDrawing.SelectionSets.count
   If ThisDrawing.SelectionSets.Item(i - 1).Name = "SSET" Then
       Set sset = ThisDrawing.SelectionSets.Item(i - 1)
       sset.Clear
       checkSS = True
       Exit For
   Else
       checkSS = False
   End If
Next

If checkSS = False Then Set sset = ThisDrawing.SelectionSets.Add("SSET")

sset.SelectOnScreen
If sset.count = 0 Then Exit Sub

'-------------------------------------
Dim ExcelApp As Object
Dim CheckData As Boolean
Dim PathFile As String
CheckData = False
Set ExcelApp = CreateObject("Excel.application")
PathFile = InputBox("Nhap vao duong dan day du cua file", "Full path")
ExcelApp.workbooks.Open PathFile
row = 1
While CheckData = False
   If ExcelApp.cells(row, 1).Formula <> "" Then
       CheckData = False
       row = row + 1
   Else
       CheckData = True
   End If
Wend
For i = 0 To sset.count - 1
   Select Case sset.Item(i).ObjectName
       Case "AcDbText"
           Set Text = sset.Item(i)
           ExcelApp.cells(row, 1 + i).Formula = Text.TextString
       Case "AcDbMText"
           Set MText = sset.Item(i)
           ExcelApp.cells(row, 1 + i).Formula = MText.TextString
   End Select
Next

ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWorkbook.Close
ExcelApp.Application.Quit
Set ExcelApp = Nothing

End Sub

Cám ơn Se7en rất nhiều, nhưng mình không sành về VBA, muốn dùng lisp chính thống cơ. Bạn viết giúp lisp cho mình đi, năn nỉ đó. Hè hè :)

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ám ơn Se7en rất nhiều, nhưng mình không sành về VBA, muốn dùng lisp chính thống cơ. Bạn viết giúp lisp cho mình đi, năn nỉ đó. Hè hè :)

lisp thì mình chịu thui,mình chỉ tìm hiểu về vba.cái này chắc bác Hoành giúp d đấy.

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
lisp thì mình chịu thui,mình chỉ tìm hiểu về vba.cái này chắc bác Hoành giúp d đấy.

Thế thì nhờ Bác Hòanh vậy, Bác Hòanh giúp đi, đang ghiền cái này đấy. Bác nào rảnh giúp luôn :)

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àm được bằng nhưng chỉ kích chuột chọn vào từng text mà thôi.

Hiện tôi không mang theo nên lúc nào đó tôi gởi lên diễn đàn.

nếu các bác thấy cần thiết thì gởi thư qua địa chỉ của mình: Xuongrong68@gmail.com

  • 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
Tôi đã làm được bằng nhưng chỉ kích chuột chọn vào từng text mà thôi.

Hiện tôi không mang theo nên lúc nào đó tôi gởi lên diễn đàn.

nếu các bác thấy cần thiết thì gởi thư qua địa chỉ của mình: Xuongrong68@gmail.com

Nghe "hơi bị khoái" rồi đấy! Nào đưa lên diễn đàn để chia sẻ với mọi người chứ!

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
Đăng nhập để thực hiện theo  

×