[To Thuc]

I used VBA to calculate, had got some results and now want to write it to a new file. How can I do it ?

Я использовал VBA для вычисления и получил некоторые результаты. Сейчас я хочу записать их в файле. Как я могу этот сделать ?

[fixo]

Сообщение от To Thuc I used VBA to calculate, had got some results and now want to write it to a new file. How can I do it ? Я использовал VBA для вычисления и получил некоторые результаты. Сейчас я хочу записать их в файле. Как я могу этот сделать ?

I don't know what you exactly need but hope you
will find it useful :

Код:

[Выделить все]

Option Explicit

'' written by Joe Sutphin
'' slightly edited for my needs

Public Sub WriteAllPolylinesToFile(strFilename As String)
Dim SelectionSet As AcadSelectionSet
Dim sSet As AcadSelectionSet
Dim intGroupCode(0) As Integer
Dim varDataCode(0) As Variant
Dim LWPolyline As AcadLWPolyline
Dim File As Integer
Dim Column As Long
Dim Row As Long
Dim Lines() As Double

  On Error Resume Next

  'do Lightweight polylines
  intGroupCode(0) = 0
  varDataCode(0) = "LWPolyline"

For Each sSet In ThisDrawing.SelectionSets
Set SelectionSet = sSet
If SelectionSet.Name = "Poly" Then
SelectionSet.Deelete
End If
Next

  'create a selection of all lightweight polylines
  Set SelectionSet = ThisDrawing.SelectionSets.Add("Poly")
  SelectionSet.Select acSelectionSetAll, , , intGroupCode, varDataCode

  If SelectionSet.Count < 1 Then Exit Sub

  File = FreeFile

  'write the polyline vertices to file
  Open strFilename For Append Access Write As #File
    Write #File, "Polyline vertices"
    'go through each polyline object
    ReDim Lines(SelectionSet.Count + 1, 1)


    For Each LWPolyline In SelectionSet
      Write #File, "Polyline Handle: " & LWPolyline.Handle
      For Row = 0 To ((UBound(LWPolyline.Coordinates) + 1) / 2) - 1
        For Column = 0 To 1
          Lines(Row, Column) = LWPolyline.Coordinates(Row + Column)
        Next Column
        Write #File, Lines(Row, 0) & ", " & Lines(Row, 1)
      Next Row
    Next LWPolyline
  Close #File


  If Err Then
    Kill strFilename
    MsgBox "There were errors, no file created!"
  End If
End Sub

Public Sub Start()
  WriteAllPolylinesToFile ("C:\MyVBA\JOE.txt") '' change full path here
End Sub

Fatty

~'J'~

[fixo]

Here is an easier way I thought
Hope this helps
Give this a try:

Код:

[Выделить все]

Public Sub WriteToTextFile(arr As Variant, fName As String)
   Dim fso, tf, i
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set tf = fso.CreateTextFile(fName, True)
   For i = 0 To UBound(arr)
   tf.Write (arr(i))
   tf.WriteBlankLines (1)
   Next
   tf.Close
End Sub

Sub test()
Dim fn As String
Dim myVar(10) As Variant
fn = "C:\MyVBA\FSO2TEXT.txt" '' > change full path by your suit
Dim n
n = 0
Do While n <= 10
myVar(n) = (5 * Rnd) + 1
n = n + 1
Loop
Call WriteToTextFile(myVar, fn)
End Sub

Fatty

~'J'~

[To Thuc]

I have read the help files anh did the same. But it doesn't work. The error was in this row

Set tf = fso.CreateTextFile(fName, True)

I think my Autocad is not right. I'll copy another version and try again.
Thank you.

[vk]

The error was in this row

Error message ...?

[fixo]

Сообщение от To Thuc I have read the help files anh did the same. But it doesn't work. The error was in this row Set tf = fso.CreateTextFile(fName, True) I think my Autocad is not right. I'll copy another version and try again. Thank you.

Hey, To Thuc, btw, are you from Vietnam or I am wrong?
If so I can to connect you with one vietnamese architect
that is a big guru in VBA
Of course, he'll explain to you all much better than me

You can use this example also:
'' How to write LWPOLYLINE coordinates to text file with
'' delimiters:

Код:

[Выделить все]

Option Explicit

Public Sub WriteCoorsToTextFile(ByVal fName As String, ByVal myVar As Variant, ByVal delim As String)

Dim tmpArr() As Variant
Dim i, j As Long
Dim inpStr As String
Dim fDesc As Integer

fDesc = FreeFile

Open fName For Output As fDesc
For i = 0 To UBound(myVar, 1)
inpStr = Str(myVar(i, 0)) & delim & Str(myVar(i, 1))
Print #fDesc, inpStr
Next i

Close #fDesc

End Sub

Public Function Get_Vertices() As Variant

Dim oPoly As AcadEntity
Dim snapPt As Variant
Dim oCoords As Variant
Dim vCnt, vxcnt, iCnt, jCnt As Integer

On Error GoTo Something_Wrong_Here

ThisDrawing.Utility.GetEntity oPoly, snapPt, vbCr & "Select polyline :"
If TypeOf oPoly Is AcadLWPolyline Then
oCoords = oPoly.Coordinates
Else: MsgBox "This object is not" & vbCrLf & "a ""LightWeightPolyline!"""
Exit Function
End If

vCnt = 0
vxcnt = (UBound(oCoords) - 1) / 2
ReDim ptArray(0 To vxcnt, 0 To 1)

For iCnt = 0 To vxcnt
For jCnt = 0 To 1
ptArray(iCnt, jCnt) = oCoords(vCnt)
vCnt = vCnt + 1
Next jCnt
Next iCnt

Something_Wrong_Here:
MsgBox Err.Description

Get_Vertices = ptArray

End Function

'' ~~~~~~~~~~~~~~~~~~~~~~~~ ''
Sub TestInput()
Dim fn, d As String
Dim v As Variant

fn = "c:\MyVBA\Coordinates.txt" '' change full path by suit
d = ","
v = Get_Vertices
Call WriteCoorsToTextFile(fn, v, d)

End Sub

Fatty

~'J'~

[To Thuc]

Сообщение от Fatty Hey, To Thuc, btw, are you from Vietnam or I am wrong? If so I can to connect you with one vietnamese architect that is a big guru in VBA Of course, he'll explain to you all much better than me

Yes I'm from Viet Nam. How could you know it ?
I'll be verry happy if you can connect me with a vietnamese architect. You see, I've lots of problem with VBA. I'm only a student.

I have sold my problem with another method: OpenAsTextStream. I know that, it isn't best way. This is my code

Private Sub CommandButton3_Click() Const ForReading = 1, ForWriting = 2, ForAppending = 3 Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 Dim fs, pro, ts, s Dim ten, ds As String Dim sd As Integer ten = InputBox("Введите имя файла", " Input file's name", "c:\protocol1.txt") ds = InputBox("Введите количество промежуток", "Input number lines", "20") sd = CInt(ds) If (Not IsNumeric(ds)) Or (sd < 0) Then MsgBox "Количество промежуток не верно!" Else Set fs = CreateObject("Scripting.FileSystemObject") fs.CreateTextFile ten 'Create a file Set pro = fs.GetFile(ten) Set ts = pro.OpenAsTextStream(ForWriting, TristateUseDefault) '....... ts.writeline Now ts.close End If End Sub

[fixo]

Сообщение от To Thuc Yes I'm from Viet Nam. How could you know it ? I'll be verry happy if you can connect me with a vietnamese architect. You see, I've lots of problem with VBA. I'm only a student. I have sold my problem with another method: OpenAsTextStream. I know that, it isn't best way. This is my code

Nice work, To Thuc
I had in my young age some friends from Vietnam and
and I know any vietnamese names
You can to connect with my friend from Vietnam, as he said me
on this adress: chubby667@yahoo.com
You can see your work on this forum also:
http://discussion.autodesk.com/forum.jspa?forumID=130
If you will connect with him, let you send my greetings to him
And don't forget about, this forum is good place to get the quick help in lisp and VBA
Here is another one, if this interesting for you:
http://www.autocad.ru/cgi-bin/f1/board.cgi?p=025
Have a good programming

~'J'~