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

[tnmtpc 207]

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

[se7en 5]

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

[tnmtpc 207]

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

[se7en 5]

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.

[tnmtpc 207]

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

[xuongrong68 0]

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

[tnmtpc 207]

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