Giúp em xuất dữ liệu toạ độ +cao trình từ CAD sang EXCELL

[CloodoPro 0]

Em có 1 file bản đồ, trên đó có ghi cao trình tại các điểm.

Nhờ các bác chỉ giáo để làm sao có thể xuất cao trình đó tương ứng với toạ độ của nó ra Excell.

File excell xuất ra có dạng :

Cột 1 : Toạ độ X

Cột 2 : Toạ độ Y

Cột 3 : Cao trình tại điểm đó (có trên bản đồ)

Bac na`o PRO thi` chuyển giúp em thì tốt quá. Em vô cùng cảm ơn.

File cad đính kèm bên dưới:

http://www.mediafire.com/?lcx2nicjzt0

[anhcos 196]

Cái bản vẽ của bạn lớn quá. Nên xóa bớt để cho bản vẽ nhỏ hơn để làm mẫu.

 

Chỉ có thể giúp cái code or tool để dùng, chứ không chuyển qua nguyên bản vẽ.

[se7en 5]

cái này gần giống công việc của mình tuy nhiên các 1 chỗ là file dữ liệu mình chỉ có text chứ không có đối tượng điểm. Bạn thử đoạn code dưới xem sao. File excel lưu o ổ C (c:\exportlevel.xls)

 

Sub ExportLevel()
Dim SSet As AcadSelectionSet
Dim Count, i, E, N As Double
Dim check As Boolean
Dim TextLocation As Variant
Dim EL As String

'---------------------------------------------------
Dim ExcelApp As Object
Set ExcelApp = CreateObject("Excel.application")
'Set ExcelApp = New Excel
ExcelApp.workbooks.Add
ExcelApp.cells(1, 1).Formula = "Point"
ExcelApp.cells(1, 2).Formula = "Northing"
ExcelApp.cells(1, 3).Formula = "Easting"
ExcelApp.cells(1, 4).Formula = "Elevation"

'----------------------------------------------------
'Check selectionset
Count = ThisDrawing.SelectionSets.Count
check = False
If Count > 0 Then
For i = 0 To Count - 1
	If ThisDrawing.SelectionSets.Item(i).Name <> "SSet" Then
		check = False
	Else
		check = True
		Exit For
	End If
Next i
End If

If check = False Then
Set SSet = ThisDrawing.SelectionSets.Add("SSet")
Else
Set SSet = ThisDrawing.SelectionSets.Item(i)
SSet.Clear
End If

SSet.SelectOnScreen

For i = 1 To SSet.Count
TextLocation = SSet.Item(i - 1).InsertionPoint
E = TextLocation(0)
N = TextLocation(1)
EL = SSet.Item(i - 1).TextString

ExcelApp.cells(i + 1, 1).Formula = i
ExcelApp.cells(i + 1, 2).Formula = Round(N, 3)
ExcelApp.cells(i + 1, 3).Formula = Round(E, 3)
ExcelApp.cells(i + 1, 4).Formula = EL

Next

ExcelApp.ActiveWorkbook.SaveAs "C:\ExportLevel.xls"
ExcelApp.Application.Quit
Set ExcelApp = Nothing
MsgBox "Finished !"

End Sub

[phantuhuong 218]

Đoạn code trên nhiều cái thừa quá, ví dụ đoạn này thay như sau:

 

Count = ThisDrawing.SelectionSets.Count
check = False
If Count > 0 Then
For i = 0 To Count - 1
	If ThisDrawing.SelectionSets.Item(i).Name  "SSet" Then
		check = False
	Else
		check = True
		Exit For
	End If
Next i
End If

If check = False Then
Set SSet = ThisDrawing.SelectionSets.Add("SSet")
Else
Set SSet = ThisDrawing.SelectionSets.Item(i)
SSet.Clear
End If

 

on error resume next
ThisDrawing.SelectionSets.Item("SSET").Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")