Convert coodinate to .txt file (3 người xem)

[Quoctoan2272]

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 ạ !


Thank you all!

 

[befaint]

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]

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.
Thank you!

 

[befaint]

@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]

@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à.

 

[Phuocam]

anh mới tốt nghiệp mẫu giáo là cao thủ đó bạn, hãy kiên nhẫn chờ.

 

[Quoctoan2272]

Đùa chứ...

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!
Thank you again!