PDA

View Full Version : Nhập tọa độ từ Excel vào AutoCAD ?



Chuotdong
09-07-08, 01:32 PM
Mình muốn xuất tọa độ của 1 loạt các điểm (có tên, tọa độ X, Y) sang AutoCAD và ngược lại thì làm thế nào nhỉ ?

hienld
09-07-08, 04:16 PM
Để có thể điều khiển AutoCAD trong Excel, lấy dữ liệu từ Excel sang AutoCAD, cần tạo đối Application chứa ứng dụng AutoCAD và biết cách sử dụng các đối tượng của ACAD như ThisDrawing, Modelspace....

Để thực hiện được việc này, cần phải thực hiện các bước sau:

1 Tham chiếu đến với thư viện mở rộng của chương trình AutoCAD.

2 Viết mã lệnh thực hiện việc khởi động chương trình AutoCAD (tạo đối tượng Application của AutoCAD).

Dưới đây sẽ trình bày cách thức khởi động chương trình AutoCAD từ ứng dụng Excel.

Tham chiếu thư viện mở rộng của chương trình AutoCAD

1 Khởi động chương trình Excel, Khởi động VBAIDE trong AutoCAD bằng cách nhấn tổ hợp phím ALT+F11. , chọn trình đơn Tools > References… để hiển thị hộp thoại References dùng để tham chiếu đến thư viện mở rộng.

2 Trong danh sách các thư viện có sẵn, chọn AutoCAD xxxx Object Library (xxxx là phiên bản của AutoCad được cài trên máy) ð Chọn OK. Như vậy là dự án VB đã có tham chiếu đến thư viện mở rộng của AutoCAD, nghĩa là người lập trình có thể truy cập đến mô hình đối tượng của AutoCAD ngay từ bên trong Visual Basic.

Viết mã lệnh khởi động chương trình AutoCAD

3 Trong Menu, chọn trình đơn Project ð Add Module để tạo mới một module chuẩn.

4 Trong cửa sổ mã lệnh của module chuẩn, nhập đoạn mã lệnh dùng để khởi động chương trình AutoCAD như sau:
Sub ConnectToAutoCAD()
Dim App As AutoCAD.Application
On Error Resume Next
Set App = GetObject(, "AutoCAD.Application")
‘ Kiểm tra xem AutoCAD đã được khởi động chưa
‘ Nếu chưa sẽ tiến hành tạo đối tượng Application
If Err Then
Err.Clear
Set App = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
‘Hiển thị cửa sổ chính của AutoCAD
App.Visible = True
MsgBox "Now running " + App.Name + _
" version " + App.Version
End Sub
5 Thực thi thủ tục: ConnectToAutoCAD như trên, chương trình AutoCAD sẽ được khởi động.

Chúc bạn thành công!

PMXD
09-07-08, 10:28 PM
Mình muốn xuất tọa độ của 1 loạt các điểm (có tên, tọa độ X, Y) sang AutoCAD và ngược lại thì làm thế nào nhỉ ?

Lấy tọa tên, độ điểm của các ô trong Excel và vẽ lên AutoCad, viết Code từ VBA Excel:

Giả sử tôi có 1 file Excel có số liệu như sau

A B C D
1 12 8 0
2 12 9 0
3 12 10 0
4 12 11 0
5 12 12 0
6 12 13 0
7 12 14 0
8 12 15 0
9 12 16 0
10 12 17 0
11 12 18 0

TRong đó cột thứ nhất là tên các điểm, cột thứ 2, 3, 4 lần lượt là tọa độ X,Y,Z của điểm tương ứng. Ta có thể viết như sau để điều khiển Cad vẽ ra các điểm này


Sub ExporttoCad()
Dim Cad As Object
Dim VPoint As Object
Dim Point(2) As Double
Dim i As Long

Set Cad = GetObject("C:\A.dwg") '(Coi nhu da co 1 file A.dwg ngoài ổ C)
For i = 1 To 11
Point(0) = Cells(i, 2)
Point(1) = Cells(i, 3)
Set VPoint = Cad.ModelSpace.AddPoint(Point)
Next i
Cad.Save

End Sub

PMXD
09-07-08, 10:31 PM
Bạn Chạy file bày xem nhé

Chuotdong
10-07-08, 01:41 PM
Cám ơn các bạn.
Ngoài ra tôi cũng đã nhờ bạn của mình làm được như sau, các bạn tham khảo, hiện chỉ có font chữ nếu là mã UNICODE thì chưa xuất sang CAD được, bạn nào biết sửa giùm:

ndtnv
23-01-09, 02:10 PM
Cám ơn các bạn.
Ngoài ra tôi cũng đã nhờ bạn của mình làm được như sau, các bạn tham khảo, hiện chỉ có font chữ nếu là mã UNICODE thì chưa xuất sang CAD được, bạn nào biết sửa giùm:
Sửa trong


Sub DrawCells(R As Range)
...
For i = 1 To M
If R(i, 1).EntireRow.Hidden = False Then
objName = EnCode(R(i, 1))
objX = R(i, 2)
objY = R(i, 3)
..


Sau đó thêm hàm này


Function EnCode(Target As Range) As String
Dim EcTxt$, codeTxt$, i%, c%, s$
On Error Resume Next
codeTxt = "\U+0000"
For i = 1 To Len(Target)
s = Mid(Target, i, 1)
c = AscW(s)
If c > 127 Then
s = Hex(c)
s = Left(codeTxt, 7 - Len(s)) & s
End If
EcTxt = EcTxt & s
Next
EnCode = EcTxt
End Function



Riêng chữ ơ bị lỗi vì mã của nó trùng với mã điều khiển nào đó

buivanbac
03-02-10, 02:19 PM
Em có bảng toạ độ các điểm trong một file excel. Em muốn vẽ các điểm này trên cad thì làm thế nào. Có anh chị nào biết chỉ giúp em với. Em có đọc một và hướng dẫn nhưng vẫn chưa hiểu.(Trong bài viết trên của bạn PMXD có hướng dẫn viết đoạn mã, nhưng viết vào đâu và sau đó làm gì nữa.)

ntbcadcam
10-05-10, 02:22 PM
Lấy tọa tên, độ điểm của các ô trong Excel và vẽ lên AutoCad, viết Code từ VBA Excel:

Giả sử tôi có 1 file Excel có số liệu như sau

A B C D
1 12 8 0
2 12 9 0
3 12 10 0
4 12 11 0
5 12 12 0
6 12 13 0
7 12 14 0
8 12 15 0
9 12 16 0
10 12 17 0
11 12 18 0

TRong đó cột thứ nhất là tên các điểm, cột thứ 2, 3, 4 lần lượt là tọa độ X,Y,Z của điểm tương ứng. Ta có thể viết như sau để điều khiển Cad vẽ ra các điểm này


Sub ExporttoCad()
Dim Cad As Object
Dim VPoint As Object
Dim Point(2) As Double
Dim i As Long

Set Cad = GetObject("C:\A.dwg") '(Coi nhu da co 1 file A.dwg ngoài ổ C)
For i = 1 To 11
Point(0) = Cells(i, 2)
Point(1) = Cells(i, 3)
Set VPoint = Cad.ModelSpace.AddPoint(Point)
Next i
Cad.Save

End Sub

Bạn có thể chỉ cụ thể bài này được k?
- file Excel phải lưu tên gì? đặt ở đâu?
- cách nhập tọa độ từ bảng Excel?

thanks

kisixanh
24-12-10, 12:29 PM
vấn đề này rất hay, nhưng hiện nay mình chẳng biết tí gì về Visual Basic cả,nếu ai có tài liệu hay hướng dẫn nào thật đơn giản, các bạn làm ơn gửi qua mail kisixanh@gmail.com
giùm mình nhe!chân thành cám ơn

Dieuvuong
31-12-10, 09:20 AM
Kinh nghiệm nho nhỏ, chỉ cần copy và paste vào trong cad thôi:
Trong excel, tạo 2 cột: 1 cột point và 1 cột tọa độ dạng (X,Y) ---> copy và paste vào cad

adoonis
09-05-11, 06:24 AM
Những thứ các bạn cần ở đây bạn Download tại đây: http://www.mediafire.com/?iiyonukkupv34if để biết thêm chi tiết bạn vào đây tham khảo nhé: http://camranhvinh.blogspot.com/2011/05/xuat-du-lieu-qua-lai-giua-autocad-va.html

th_kid2001
09-10-11, 09:38 PM
Bạn sài thử cái này xem. File Excel lưu tùy ý miễn nhớ đường dẫn.
Có hướng dẫn theo kèm đó

van_k49
16-01-13, 05:15 PM
Em có một phai dữ liệu trong exel nhờ các anh chị chuyển hộ sang cad hộ em với, đúng theo tọa độ đã có ở trong exel

van_k49
17-01-13, 10:39 AM
Cảm ơn bạn "tiện ích cho trắc địa" đúng là cái mình đang cần, nhưng bạn có thể sửa lại cho mình chút ít nữa được không. trong tiện ích load điểm, cột nhập tên điểm chuyển thành cột họ và tên có được không. vì mình nhập số thứ tự vào thì đúng nhưng khi nhập họ và tên người load vào cad lại không đúng nữa. Minh gửi phai mẫu bạn giúp mình nhé, minh đang rất cần nó xin cảm ơn nhiều

van_k49
17-01-13, 10:52 AM
Có ai không? giúp mình với.............

hung_xu20032000
23-04-13, 05:43 PM
Mình thật sự không hiểu "van_k49 (http://www.giaiphapexcel.com/forum/member.php?414937-van_k49)" định làm cái gì. Nếu bạn là dân trắc địa thì dùng phần mềm của Hài hòa (HS, TÔPO) hoặc các phần mềm khác tương tự đi. Con nếu không phải hãy hỏi dân trắc địa là xong ngay.

banhtun
25-11-13, 10:19 PM
giúp mình dòng code này với ???

Private Sub CBViDu_Change()


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo thoat


Dim bEnableEvents As Boolean
bEnableEvents = Application.EnableEvents
Application.EnableEvents = False


If Target.Column = 2 Then
Call thaydoi
Call MaKH
ActiveCell.Select
Else
Call Hide
End If
thoat: Application.EnableEvents = bEnableEvents


Dim i As Integer
Dim dau As Integer, cuoi As Integer
Dim DL As String, Dgiai As String
Dim gt As String
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column = 3 Then
If IsEmpty(Target) Or Cells(Target.Row, 1).Value <> 0 Then GoTo thoat1
If InStr(1, Target.Value, ":") > 0 Then
dau = InStr(1, Target.Value, ":")
Else
dau = 0
End If
If InStr(1, Target.Value, "=") > 0 Then
cuoi = InStr(1, Target.Value, "=") - 1
Else
cuoi = Len(Target.Value)
End If
If cuoi = dau Or cuoi < dau Then GoTo thoat1
Dgiai = RTrim(LTrim(Left(Target.Value, cuoi)))
DL = RTrim(LTrim(Mid(Target.Value, dau + 1, cuoi - dau)))
DL = Replace(DL, ",", ".")
Target.Formula = Dgiai & " = " & Round(Evaluate(DL), 3)
Target.Characters(Start:=Len(Dgiai) + 4, Length:=Len(Round(Evaluate(DL), 3))).Font.ColorIndex = 3
Target.Interior.ColorIndex = xlNone
For i = Target.Row To 1 Step -1
If Cells(i, 1).Value > 0 Then
If DiengiaiTL(Cells(Target.Row + 1, Target.Column)) = 0 Then
Cells(i, 5).Formula = "=DiengiaiTL(C" & (i + 1) & ":C" & Target.Row & ")"
Else
gt = Cells(i, 4).Formula
Cells(i, 4).Formula = gt
End If
Exit For
End If
Next
GoTo thoat1


Target.Interior.ColorIndex = 4
End If
thoat1:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub








cảm ơn các bạn.