Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
3 replies to this topic

#1 CloodoPro

CloodoPro

    biết pan

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

Đã gửi 27 August 2009 - 03:23 PM

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

  • 0

#2 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 31 August 2009 - 11:51 AM

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ẽ.
  • 0
Clear sky!

MF Rock collection.

#3 se7en

se7en

    biết vẽ ellipse

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

Đã gửi 07 November 2009 - 02:44 PM

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

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

#4 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 30 November 2009 - 09:19 PM

Đ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")

  • 0
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!