Convert coodinate to .txt file

Quoctoan2272

Thành viên mới
Tham gia ngày
23 Tháng sáu 2018
Bài viết
4
Thích
0
Điểm
1
Tuổi
27
#1
Xin chào các cao thủ của Diễn đàn!
Mình là thành viên mới của diễn đàn. Có 1 vấn đề rất mong được các cao thủ giúp đỡ hướng xử lí .
Khi xuất tọa độ điểm (X,Y,Z) từ AutoCad, mình muốn xử lí dữ liệu tọa độ theo (X,Y,Z) vào 1 định dạng Form đuôi .txt mới để Import vào 1 phần mềm khác.
Trước mình dùng Autocad Full thì vấn đề này được xử lí bằng Lisp dễ dàng hơn. Nhưng nay vì 1 số lí do, cty mới chỉ dùng Cad LT nên k thể dùng Lisp.
Các cao thủ có hướng gì k (dùng Excel, VBA...etc) xin giúp đỡ với ạ !
1529739199319.png

Cảm ơn all!
 
Tham gia ngày
6 Tháng một 2011
Bài viết
7,490
Thích
8,048
Điểm
560
#2
Chủ thớt.
Chép đoạn text trong AutoCAD cho vào một text file rồi gửi lên đây. Kèm một file mẫu kết quả tương ứng.
Không cho dùng lisp thì vẽ Cad còn thú vị gì nữa....
 

Quoctoan2272

Thành viên mới
Tham gia ngày
23 Tháng sáu 2018
Bài viết
4
Thích
0
Điểm
1
Tuổi
27
#3
Chủ thớt.
Chép đoạn text trong AutoCAD cho vào một text file rồi gửi lên đây. Kèm một file mẫu kết quả tương ứng.
Không cho dùng lisp thì vẽ Cad còn thú vị gì nữa....
cty mình chủ yếu dùng AVEVA nên Cad k đc đầu tư nhiều. hi
File FromCad.txt Là file mình copy từ text window của Acad.
Flie EXTRUSION.txt Là file kết quả mình cần.
Cảm ơn!
 

File đính kèm

Tham gia ngày
6 Tháng một 2011
Bài viết
7,490
Thích
8,048
Điểm
560
#4
@chủ thớt.
Gía mua AutoCAD đâu có mắc.

Bài của bạn có anh mới tốt nghiệp mẫu giáo mà ghé qua thì sẽ làm cho bạn. Mình không dùng máy tính.
 

Quoctoan2272

Thành viên mới
Tham gia ngày
23 Tháng sáu 2018
Bài viết
4
Thích
0
Điểm
1
Tuổi
27
#5
@chủ thớt.
Gía mua AutoCAD đâu có mắc.

Bài của bạn có anh mới tốt nghiệp mẫu giáo mà ghé qua thì sẽ làm cho bạn. Mình không dùng máy tính.
Bác cứ đùa, Cái đó mình đâu có quyết định được.
Vì k rành về lập trình Macro bên Excel nên mới nhờ đến các cao thủ mà.
 

hpkhuong

Thành viên gạo cội
Tham gia ngày
20 Tháng năm 2011
Bài viết
4,440
Thích
3,850
Điểm
560
#7
@chủ thớt.
Gía mua AutoCAD đâu có mắc.

Bài của bạn có anh mới tốt nghiệp mẫu giáo mà ghé qua thì sẽ làm cho bạn. Mình không dùng máy tính.
Đùa chứ...
Mã:
Public Sub GPE()
Dim Fso As Object, ObjFile As Object, TextS As Object, TLines
Dim sArr, Item, K As Long, I As Long, Str, Path As String
ReDim sArr(1 To 1000, 1 To 3)

Set Fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Txt Files", "*.txt", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
    Path = Fso.GetParentFolderName(.SelectedItems(1))
'On Error Resume Next
sArr(1, 1) = "NEW EXTRUSION": sArr(2, 1) = "ORI X IS X and Y is Y"
sArr(3, 1) = "HEIG 100": sArr(4, 1) = "NEW LOOP": sArr(5, 1) = "NEW VERTEX"
sArr(6, 1) = "END"
K = 8
For Each Item In .SelectedItems
    Set TextS = Fso.OpenTextFile(Item, 1, , -2)
        TLines = Split(TextS.ReadAll, vbCrLf)
        For I = LBound(TLines) To UBound(TLines)
        Str = TLines(I)
        
            K = K + 1
            sArr(K - 1, 1) = "NEW VERTEX"
            sArr(K, 1) = "POS X" & Format(Round(Application.Trim(Mid(TLines(I), 24, 10)), 2), "#0.00")
            sArr(K, 2) = "Y" & Format(Round(Application.Trim(Mid(TLines(I), 37, 10)), 2), "#0.00")
            sArr(K, 3) = "z" & Format(Round(Application.Trim(Mid(TLines(I), 50, 10)), 2), "#0.00")
            sArr(K + 1, 1) = "END"
            K = K + 3
        Next
Next
End With

If K Then
    Workbooks.Add
    With ActiveWorkbook
        .Sheets(1).Range("A1").Resize(K, 3).Value = sArr
        .SaveAs filename:=Path & "\" & Format(Now, "yyyymmdd") & "_EXTRUSION" & ".txt", FileFormat:=xlUnicodeText
        .Close True
    End With
End If
MsgBox "Xong - File da duoc luu cung Thu Muc voi file txt ban dau!"
Application.ScreenUpdating = True
End Sub
 

Quoctoan2272

Thành viên mới
Tham gia ngày
23 Tháng sáu 2018
Bài viết
4
Thích
0
Điểm
1
Tuổi
27
#8
Đùa chứ...
Mã:
Public Sub GPE()
Dim Fso As Object, ObjFile As Object, TextS As Object, TLines
Dim sArr, Item, K As Long, I As Long, Str, Path As String
ReDim sArr(1 To 1000, 1 To 3)

Set Fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Txt Files", "*.txt", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
    Path = Fso.GetParentFolderName(.SelectedItems(1))
'On Error Resume Next
sArr(1, 1) = "NEW EXTRUSION": sArr(2, 1) = "ORI X IS X and Y is Y"
sArr(3, 1) = "HEIG 100": sArr(4, 1) = "NEW LOOP": sArr(5, 1) = "NEW VERTEX"
sArr(6, 1) = "END"
K = 8
For Each Item In .SelectedItems
    Set TextS = Fso.OpenTextFile(Item, 1, , -2)
        TLines = Split(TextS.ReadAll, vbCrLf)
        For I = LBound(TLines) To UBound(TLines)
        Str = TLines(I)
       
            K = K + 1
            sArr(K - 1, 1) = "NEW VERTEX"
            sArr(K, 1) = "POS X" & Format(Round(Application.Trim(Mid(TLines(I), 24, 10)), 2), "#0.00")
            sArr(K, 2) = "Y" & Format(Round(Application.Trim(Mid(TLines(I), 37, 10)), 2), "#0.00")
            sArr(K, 3) = "z" & Format(Round(Application.Trim(Mid(TLines(I), 50, 10)), 2), "#0.00")
            sArr(K + 1, 1) = "END"
            K = K + 3
        Next
Next
End With

If K Then
    Workbooks.Add
    With ActiveWorkbook
        .Sheets(1).Range("A1").Resize(K, 3).Value = sArr
        .SaveAs filename:=Path & "\" & Format(Now, "yyyymmdd") & "_EXTRUSION" & ".txt", FileFormat:=xlUnicodeText
        .Close True
    End With
End If
MsgBox "Xong - File da duoc luu cung Thu Muc voi file txt ban dau!"
Application.ScreenUpdating = True
End Sub
Tuyệt quá, xin chân thành cảm ơn cao thủ. Dùng nó và dựa vào để taọ thêm các code primitives type khác cho phần mềm của mình đang dùng sẽ rất OK!
Cảm ơn again!
 
Top