Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
6 replies to this topic

#1 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 01 February 2008 - 11:05 AM

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

#2 se7en

se7en

    biết vẽ ellipse

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

Đã gửi 01 February 2008 - 05:32 PM

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


  • 1
Mê xe và súng
Thích để súng trong xe

#3 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 01 February 2008 - 06:25 PM

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

#4 se7en

se7en

    biết vẽ ellipse

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

Đã gửi 01 February 2008 - 07:08 PM

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.
  • 0
Mê xe và súng
Thích để súng trong xe

#5 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 01 February 2008 - 07:17 PM

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

#6 xuongrong68

xuongrong68

    Chưa sử dụng CAD

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

Đã gửi 02 April 2008 - 03:54 PM

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

#7 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 02 April 2008 - 04:04 PM

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